Formatlı Metni HTML olarak biçimlendirme

tamer42 · 7 Mayıs 2023

Merhabalar,

Excel hücresinde yer alan metini bire-bir formatıyla e-mail gövdesine almak için;

aşağıdaki kodu buldum, burda ufak bir eksiklik var, yazı Fontunun adı ve fontun boyutunu da nasıl alabiliriz?;
Bu kodda tüm kelimleride fontun boyutu standart gelmekte;

https://stackoverflow.com/questions/33620147/convert-rich-text-to-html-formatting-tags

ilgi ve alakanız için şimdiden teşekkürler,

iyi Pazarlar.

Kod:

Function fnConvert2HTML(myCell As Range) As String
Dim bldTagOn, itlTagOn, ulnTagOn, colTagOn As Boolean
Dim i, chrCount As Integer
Dim chrCol, chrLastCol, htmlTxt, htmlEnd As String

bldTagOn = False
itlTagOn = False
ulnTagOn = False
colTagOn = False
chrCol = "NONE"
'htmlTxt = "<html>"
htmlTxt = ""
chrCount = myCell.Characters.Count

For i = 1 To chrCount
htmlEnd = ""
With myCell.Characters(i, 1)
If (.Font.Color) Then
chrCol = fnGetCol(.Font.Color)
If Not colTagOn Then
htmlTxt = htmlTxt & "<font color=#" & chrCol & ">"
colTagOn = True
Else
If chrCol <> chrLastCol Then htmlTxt = htmlTxt & "</font><font color=#" & chrCol & ">"
End If
Else
chrCol = "NONE"
If colTagOn Then
htmlEnd = "</font>" & htmlEnd
'htmlTxt = htmlTxt & "</font>"
colTagOn = False
End If
End If
chrLastCol = chrCol

If .Font.Bold = True Then
If Not bldTagOn Then
htmlTxt = htmlTxt & "<b>"
bldTagOn = True
End If
Else
If bldTagOn Then
'htmlTxt = htmlTxt & "</b>"
htmlEnd = "</b>" & htmlEnd
bldTagOn = False
End If
End If

If .Font.Italic = True Then
If Not itlTagOn Then
htmlTxt = htmlTxt & "<i>"
itlTagOn = True
End If
Else
If itlTagOn Then
'htmlTxt = htmlTxt & "</i>"
htmlEnd = "</i>" & htmlEnd
itlTagOn = False
End If
End If

If .Font.Underline > 0 Then
If Not ulnTagOn Then
htmlTxt = htmlTxt & "<u>"
ulnTagOn = True
End If
Else
If ulnTagOn Then
'htmlTxt = htmlTxt & "</u>"
htmlEnd = "</u>" & htmlEnd
ulnTagOn = False
End If
End If

If (Asc(.Text) = 10) Then
htmlTxt = htmlTxt & htmlEnd & "<br>"
Else
htmlTxt = htmlTxt & htmlEnd & .Text
End If

End With
Next

If colTagOn Then
htmlTxt = htmlTxt & "</font>"
colTagOn = False
End If
If bldTagOn Then
htmlTxt = htmlTxt & "</b>"
bldTagOn = False
End If
If itlTagOn Then
htmlTxt = htmlTxt & "</i>"
itlTagOn = False
End If
If ulnTagOn Then
htmlTxt = htmlTxt & "</u>"
ulnTagOn = False
End If
'htmlTxt = htmlTxt & "</html>"
fnConvert2HTML = htmlTxt
End Function

Kod:

Function fnGetCol(strCol As String) As String
Dim rVal, gVal, bVal As String
strCol = Right("000000" & Hex(strCol), 6)
bVal = Left(strCol, 2)
gVal = Mid(strCol, 3, 2)
rVal = Right(strCol, 2)
fnGetCol = rVal & gVal & bVal
End Function

necati · 7 Mayıs 2023

Merhaba tamer bey. Normalde exceldeki biçimlendirme ile mail gövdesini tablo olarak alabiliyoruz.
Tablo olarak değil de düz metin olarak fakat biçimlendirmeler kalsın diyorsanız, tabloyu metne dönüştür yapınca istediğiniz oluyor gibi geldi bana.
Şunu denedim ve biçimlendirmeler aynen kaldı.

Kod:

Sub SendEmail()
'microsoft word object x.x lib ve outlook object x.x lib yükle

    Dim XL_Outlook As Outlook.Application
    Dim XL_Email As Outlook.MailItem
    Dim XL_Inspector As Outlook.Inspector
    Dim Word_Document As Word.Document
    Dim Mesaj As String

    Mesaj = "Sayın Yönetici," & vbNewLine

    Set XL_Outlook = New Outlook.Application
    Set XL_Email = XL_Outlook.CreateItem(olMailItem)

    With XL_Email
        .BodyFormat = olFormatHTML
        .Display
        .To = "deneme@deneme.com"
        .Subject = "Günlük Satış Analizi"

        Set XL_Inspector = .GetInspector
        Set Word_Document = XL_Inspector.WordEditor

        Word_Document.Range.InsertBefore Mesaj
        Word_Document.Range.InsertAfter vbCrLf
        Sayfa1.Range("A1:I20").Copy
        Word_Document.Range(Len(Mesaj), Len(Mesaj)).Paste
        Word_Document.Tables(1).Rows.ConvertToText Separator:=wdSeparateByTabs, NestedTables:= _
        True
      
    End With
  Application.CutCopyMode = False

    Set XL_Inspector = Nothing
    Set Word_Document = Nothing
    Set XL_Outlook = Nothing
    Set XL_Email = Nothing
End Sub

tamer42 · 7 Mayıs 2023

necati' Alıntı:

Merhaba tamer bey. Normalde exceldeki biçimlendirme ile mail gövdesini tablo olarak alabiliyoruz.
Tablo olarak değil de düz metin olarak fakat biçimlendirmeler kalsın diyorsanız, tabloyu metne dönüştür yapınca istediğiniz oluyor gibi geldi bana.
Şunu denedim ve biçimlendirmeler aynen kaldı.

Kod:

Sub SendEmail()
'microsoft word object x.x lib ve outlook object x.x lib yükle

    Dim XL_Outlook As Outlook.Application
    Dim XL_Email As Outlook.MailItem
    Dim XL_Inspector As Outlook.Inspector
    Dim Word_Document As Word.Document
    Dim Mesaj As String

    Mesaj = "Sayın Yönetici," & vbNewLine

    Set XL_Outlook = New Outlook.Application
    Set XL_Email = XL_Outlook.CreateItem(olMailItem)

    With XL_Email
        .BodyFormat = olFormatHTML
        .Display
        .To = "deneme@deneme.com"
        .Subject = "Günlük Satış Analizi"

        Set XL_Inspector = .GetInspector
        Set Word_Document = XL_Inspector.WordEditor

        Word_Document.Range.InsertBefore Mesaj
        Word_Document.Range.InsertAfter vbCrLf
        Sayfa1.Range("A1:I20").Copy
        Word_Document.Range(Len(Mesaj), Len(Mesaj)).Paste
        Word_Document.Tables(1).Rows.ConvertToText Separator:=wdSeparateByTabs, NestedTables:= _
        True
     
    End With
  Application.CutCopyMode = False

    Set XL_Inspector = Nothing
    Set Word_Document = Nothing
    Set XL_Outlook = Nothing
    Set XL_Email = Nothing
End Sub

Necati Hocam teşekkür ederim

Formatlı Metni HTML olarak biçimlendirme

tamer42

Destek Ekibi

necati

tamer42

Destek Ekibi