Условное форматирование с HTMLBody - PullRequest
0 голосов
/ 07 сентября 2018

Приведенный ниже код копирует предварительно определенный диапазон в соответствии с критериями. Как должен выглядеть код в строке «Else» в «Range function», чтобы при критериях = 0 только текст из strText2 был взят и вставлен в тело письма? Проблема в том, что мне могут понадобиться два кода .HTMLBody, например:

для критериев> 1

  .HTMLBody = strText & RangetoHTML(rng) & "<br><br>" & GetBoiler(Environ("appdata") & "\Microsoft\Signatures\" & strFilename & ".htm")

для критериев = 0

  .HTMLBody = strText2 

Функция GetBoiler:

Function GetBoiler(ByVal sFile As String) As String
Dim fso As Object
Dim ts As Object

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)

GetBoiler = ts.readall

ts.Close
End Function

Функция диапазона: Функция RangetoHTML (rng As Range)

Dim fso As Object
Dim ts As Object
Dim TempWB As Workbook

With Worksheets("Auswertung")
   loLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
   .Range("$A$7:$D$" & loLetzte).AutoFilter Field:=3, Criteria1:=">0"
If .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then
      .AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1). _
    SpecialCells(xlCellTypeVisible).Copy
Else
 'copy only the strText2  
End If
   .AutoFilterMode = False
End With
End Function

Основная подфункция:

Sub Mail_Klicken()

Dim olApp As Object

Dim datDatum As Date
Dim StrBody As String
Dim intZeile As Integer
Dim OutMail As Object
Dim rng As Range

Dim strMailverteilerTo As String
Dim strText As String
Dim strFilename As String
Dim loLetzte As Long

strMailverteilerTo = "sdfgsdf@gmx.de"


strText = "<span style='font-size:10.0pt;font-family:""Arial"",""sans-serif"";color:black'>hello,<br><br>hello fellows.<br><br>"


strText2 = "<span style='font-size:10.0pt;font-family:""Arial"",""sans-serif"";color:black'>dfgfg,<br><br>gfgfgfgfg.<br><br>"

Application.DisplayAlerts = True

Set rng = Selection.SpecialCells(xlCellTypeVisible)
Set olApp = CreateObject("Outlook.Application")

With olApp.CreateItem(0)

    .to = strMailverteilerTo
    .Subject = "check"

     strFilename = "Standard"

     If Application.UserName = "asd" Then strFilename = "asd"


    .HTMLBody = strText & RangetoHTML(rng) & "<br><br>" & GetBoiler(Environ("appdata") & "\Microsoft\Signatures\" & strFilename & ".htm")

   .Display

End With
Set olApp = Nothing
 End Sub

1 Ответ

0 голосов
/ 14 сентября 2018

Это как-то работает. Кажется, нет ошибки

...