tekstkleur + lettertype en grootte bepalen in VBA

[HORADADA]

Dag allemaal,
ik heb een body voor een email geschreven in VBA, en wil bepaalde delen tekst laten uitspringen door groter lettertype en in kleur (bv rood of een ander kleur)

Hoe kan ik lettertype en kleur bepalen in VBA?

Heb al van alles geprobeerd, maar blijkbaar zie ik iets over het hoofd.
Kan er mij iemand op weg helpen?
alvast bedankt!

 

[zapatr]

Tyo in het helpvenster als zoekopdracht: lettertype of font en je vindt een schat aan voorbeelden.

 

[HORADADA]

even terug!
Heb op internet gezocht, en inderdaad een hele hoop hints, maar geen enkele bruikbare volgens mij. (geen enkel dat werkt)
Misschien is het wel niet mogelijk, zodat ik mij vraag anders zal stellen, in de hoop dat mij iemand op weg kan helpen:
Ik heb in een VBA macro een body van een email staan, en wil bepaalde gegevens in een groter lettertype en in kleur plaatsen.

htmlBody = "Geachte" & vbNewLine & _
          "Dear," & vbNewLine & vbNewLine & _
          "dit is een voorbeeld ...    : " & Weeknr & vbNewLine & _
          "Dit is een voorbeeld ...    : " & cat & vbNewLine & _
          "Dit is een voorbeeld ...    : " & subcat & vbNewLine & vbNewLine & _
          "Nr. als voorbeeld ...        : " & TempFileName01 & vbNewLine & vbNewLine & _
          "Date als voorbeeld ..       : " & dat1 & "  -  10H" & vbNewLine & vbNewLine & _
          "Met achting," & vbNewLine & _
          " "

Ik verstuur deze e-mails via outlook.

De bedoeling is dat enkel de waarden weeknr,cat, subcat, tempfilename01 en dat1 in een groter lettertype komen te staan en in het rood.
Al zoveel mogelijkheden geprobeerd, en telkens krijg ik een fout, zodat ik denk dat ik iets over het hoofd zie, of dat wat ik wil bereiken misschien niet mogelijk is.

Het zou fijn zijn, mocht er mij iemand willen uitsluitsel geven, ofwel hoe ik dat moet doen, of misschien duidelijk te stellen dat het niet mogelijk is wat ik wil doen.

alvast bedankt!
groeten

 

[zapatr]

Dit is het forum van EXCEL, dus ik neem aan dat die vba-code ook in Excel staat. Maar in welke cellen in het werkblad komt de tekst dan te staan?

 

[HORADADA]

Dag,
Het is een Excel toepassing.
Ik laad Excelbladen in, en heb de macro geschreven om die Excelbladen te bewerken, en als deze bewerkt zijn, dan heb ik een knop op het lint geplaatst, waarbij ik het resultaat via een macro en outlook verstuur.

Weeknr: bereken ik via de machine datum
cat: is een gedeelte van een cel uit een waarde van het Excelblad.
subcat: is een gedeelte van een cel uit een waarde van het Excelblad.
TempFileName01 : is een gedeelte van de naam van het werkblad + aanpassing
dat1 : is berekend aan de hand van de machine datum.


Ik verzamel al deze gegevens en verstuur het werkblad als een bijlage, en in de email vermeld ik bovenstaande gegeven.
De macro werkt perfect, doch had ik graag deze waarde laten uitspringen in de body van de email.
Heb al van alles geprobeerd, en niets lukt.
Van zodra ik probeer kleur erin te krijgen, verdwijnt de body van mijn email, ofwel krijg ik een fout in de macro.
Zonder kleur of groter lettertype werkt het perfect.

Ik weet eigenlijk niet of het mogelijk is, wat ik wil realiseren.

in elk geval bedankt voor de reactie.

 

[zapatr]

Helaas geen antwoord op mijn vraag en dus ook geen antwoord waar je wat mee kunt doen. Als het bestand en zelfs de vba-code niet kan worden ingezien, dan kan naar mijn mening geen goed antwoord worden gegeven.
Je hebt op internet gezocht schrijf je. Ik beval je nochtans aan om in de vba-helpfile van Excel te zoeken met de woorden lettertype en font. Dan vindt je zowat ALLES wat er in Excel met vba daaromtrent mogelijk is.

 

[HORADADA]

Dag,
Ik begrijp niet wat je bedoelt!
ik heb de macro in Excel geschreven, en ik gebruik geen andere toepassing dan Excel.

Ik stuur U bij deze de volledige code.

misschien heb ik een andere fout gemaakt, dat aan de oorzaak ligt van het feit dat het niet werkt.
Alvast bedankt!

de code:

Sub Mail()
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim OutApp As Object
    Dim OutMail As Object
   
    Dim cat As String
    Dim subcat As String
    Dim TempFileNameJL As String
    Dim dat1 As String
    Dim Weeknr As Integer
    

 Weeknr = 1 + Int((Date - DateSerial(Year(Date + 4 - Weekday(Date + 6)), 1, 5) + Weekday(DateSerial(Year(Date + 4 - Weekday(Date + 6)), 1, 3))) / 7)

dat1 = Date + 1
week1 = Weeknr
    
    Range("B2").Select
    cat = Range("B2")
    
    Range("C2").Select
    subcat = Range("C2")

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Sourcewb = ActiveWorkbook

    'Copy the sheet to a new workbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook

    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 2000-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2010, we exit the sub when your answer is
            'NO in the security dialog that you only see  when you copy
            'an sheet from a xlsm file with macro's disabled.
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "Your answer is NO in the security dialog"
                Exit Sub
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With

    '    'Change all cells in the worksheet to values if you want
    '    With Destwb.Sheets(1).UsedRange
    '        .Cells.Copy
    '        .Cells.PasteSpecial xlPasteValues
    '        .Cells(1).Select
    '    End With
    '    Application.CutCopyMode = False

    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "voorbeeld - " & Sourcewb.Name & " " _
                 & Format(Now, "dd-mmm-yy")

    TempFileNameJL = Sourcewb.Name
    TempFileNameJL = Mid(TempFileName, 34, 6)


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
        With OutMail
            .To = ""
            .CC = ""
            .BCC = "MAILING LIST"
            .Subject = "voorbeeld: " & Weeknr & " -" & " voorbeeld : " & Weeknr
            .htmlBody = StrBody
        
    
htmlBody = "voorbeeld," & vbNewLine & _
          "voorbeeld" & vbNewLine & vbNewLine & _
          "voorbeeld     :" & Weeknr & vbNewLine & _
          "voorbeeld  :" & Weeknr & vbNewLine & vbNewLine & _
          "voorbeeld  : " & cat & vbNewLine & _
          "voorbeeld  : " & subcat & vbNewLine & vbNewLine & _
          "voorbeeld  : " & TempFileNameJL & vbNewLine & vbNewLine & _
          "voorbeeld : " & dat1 & "  -  10H" & vbNewLine & vbNewLine & _
          "voorbeeld" & vbNewLine & _
          "voorbeeld" & vbNewLine & _
          "voorbeeld" & vbNewLine & _
          "Tel.: +XXXX" & vbNewLine & _
          "Email: email" & vbNewLine & vbNewLine & vbNewLine & _
          ""
     
           .Body = htmlBody

            .Attachments.Add Destwb.FullName
            .Send   'or use .Display
        End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With

    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

 

[huijb]

@HORADADA Graag de code tussen codetags plaatsen. Hoe je dat kan doen lees je hier http://www.helpmij.nl/forum/showthr...-de-helpers-in-deze-sectie-van-dienst-te-zijn.

 

[HORADADA]

sorry moderator!
ben nieuw op het forum!

 

[HORADADA]

@ zaptr,
Ik heb de volledige code gepost en heb nog eens het internet afgezocht, en nog van alles geprobeerd.
Ik stoot altijd op hetzelfde probleem.
ofwel krijg ik een fout in de code, als ik de code wijzig, en als ik geen fout krijg bij het aanpassen van de code, dan is de body van de email leeg in outlook.
Ik doe blijkbaar iets verkeerd of er is iets verkeerd met de code , maar weet niet wat ik verkeerd doe.
Elke tip die mij verder kan helpen is welkom!
groeten!

 

[HORADADA]

Hoi iedereen!
graag had ik willen vragen of er iemand raad weet met mijn probleem?
Misschien is het niet mogelijk wat ik wil realiseren.
Kan mij daar iemand uitsluitsel over geven?
elke reactie is welkom!
Thx

 

[HORADADA]

Hallo!
Ik heb uiteindelijk het probleem zelf opgelost.
voor mensen die het zou kunnen interesseren, plaats ik de code hier.
dank aan de mensen die op zijn minst hebben helpen denken!
groeten!

Sub Mail ()
'Working in 2000-2010

    Dim strbody As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim cat As String
    Dim subcat As String
    Dim TempFileNameJL As String
    Dim dat1 As String
    Dim Weeknr As Integer
    

   Dim OutApp As Outlook.Application ' in extra van VBA > verwijzing > microsoft outlook office library (aanvinken)
   Dim OutMail As Outlook.MailItem
  
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)
    
     Weeknr = 1 + Int((Date - DateSerial(Year(Date + 4 - Weekday(Date + 6)), 1, 5) + Weekday(DateSerial(Year(Date + 4 - Weekday(Date + 6)), 1, 3))) / 7)
     dat1 = Date + 1
     week1 = Weeknr
     Range("B2").Select
     cat = Range("B2")
     Range("C2").Select
     subcat = Range("C2")


   With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Sourcewb = ActiveWorkbook
 
'Copy the sheet to a new workbook
    ActiveSheet.Copy
    Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 2000-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2010, we exit the sub when your answer is
            'NO in the security dialog that you only see  when you copy
            'an sheet from a xlsm file with macro's disabled.
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "Your answer is NO in the security dialog"
                Exit Sub
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With

    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "TEST IN ONDERWERP - " & Sourcewb.Name & " " _
                 & Format(Now, "dd-mmm-yy")

    TempFileNameJL = Sourcewb.Name
    TempFileNameJL = Mid(TempFileName, 34, 6)
            
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)
      

   With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
    

 If ActiveWorkbook.Path <> "" Then
         

        strbody = "<font size=""3"" face=""Arial Narrow"">" & _
                  "Tekstlijn,<br>" & _
                  "Tekstlijn,<br><br>" & _
                  "Tekstlijn   : " & "<font size=""3"" face=""Arial Black"" color=""blue"">" & Weeknr & "<br><br>" & _
                  "<font size=""3"" face=""Arial Narrow"" color=""black"">" & _
                  "Tekstlijn: " & "<font size=""3"" face=""Arial Black"" color=""blue"" FontStyle=""bold"">" & cat & "<br>" & _
                  "<font size=""3"" face=""Arial Narrow"" color=""black"">" & _
                  "Tekstlijn : " & "<font size=""3"" face=""Arial Black"" color=""blue"" FontStyle=""bold"">" & subcat & "<br>" & _
                  "<font size=""3"" face=""Arial Narrow"" color=""black"">" & _
                  "Tekstlijn : " & "<font size=""3"" face=""Arial Black"" color=""green"" FontStyle=""bold"">" & TempFileNameJL & "<font size=""3"" face=""Constantia"" color=""red"" FontStyle=""bold"">" & " Tekstlijn " & "<br><br>" & _
                  "<font size=""3"" face=""Arial Narrow"" color=""black"">" & _
                  "Tekstlijn " & "<font size=""3"" face=""Arial Black"" color=""red"" FontStyle=""bold"">" & dat1 & "Tekstlijn" & "<br><br>" & _
                  "<font size=""3"" face=""Arial Narrow"" color=""black"">" & _
                  "Tekstlijn," & "<br>" & _
                  "Tekstlijn" & "<br><br>" & _
                  "<font size=""3"" face=""Arial Narrow"" color=""black"">" & _
                  "Tekstlijn" & "<br>" & _
                  "Tekstlijn" & "<br>" & _
                  "Tekstlijn" & "<br><br><br>" & _
                  ""

   On Error Resume Next
    With OutMail
       
             .To = "" ' email invullen indien gewenst
            .CC = ""
            .Attachments.Add Destwb.FullName
            .BCC = "test "   ' groep emailadressen aangemaakt in outlook
            .Subject = "Tekstlijn" & Weeknr & "/" & TempFileNameJL & " -" & " Tekstlijn: " & Weeknr & "/" & TempFileNameJL
            .htmlBody = strbody
            .SendUsingAccount = OutApp.Session.Accounts.Item(5) ' het cijfer bepaalt de account in outlook waarvan men wil versturen

      
            .Display   'or use .Send
        End With
        On Error GoTo 0
       .Close SaveChanges:=False

        Set OutMail = Nothing
        Set OutApp = Nothing
    Else
        MsgBox "The ActiveWorkbook does not have a path, Save the file first."
    End If

'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    End With
End Sub