Text in Html für Spalte

Sub html_umwandlung() Dim arrText, strText$, i% arrText = Split(Range("E21"), Chr(10)) For i = LBound(arrText) To UBound(arrText) If arrText(i) = "" Then strText = strText & Chr(10) Else strText = strText & "" & arrText(i) & "" & Chr(10) End If Next i Range("F21") = strText End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Patrick,
da noch niemand geantwortet hat, versuche ich mich mal daran.
Obwohl es für mich nicht ganz eindeutig ist, was Du möchtest, kann Dir mal mein HTML-Umsetztool geben, welches einen Teil der formatierten Zelle in HTML umsetzt (z.B. für die Verwendung in eMails)
Fett, Kursiv und Unterstrich werden auch innerhalb der Zelle abgearbeitet, Farben, Schrift und Größe derzeit nur für die gesamte Zelle.
Bei Bedarf kannst Du <span> auch in <div> abändern. Abweichend zu deiner Vorgabe werden die Absätze aber nicht mit dem P-Tag abgesetzt sondern mit <br>, sonst gibt das so einen blöden Extraabstand.
Also probiere es aus. Vielleicht ist es ja das, was Du suchst:

Sub FormatiereZelltextinHTML()

'Umsetzung der Zellen in A nach HTML in B

 Dim Obj As Range

 For Each Obj In Range("$A1:$A308")

  If Obj.Value &LT;&GT; "" Then Obj.Offset(0, 1).Value = GetHTML(Obj, False)

 Next Obj

End Sub

Function GetHTML(Obj As Range, Optional bHG As Boolean) As String

'Funktion setzt die Parameter/Wert/Formatierung einer Zelle in HTML um

 Dim T1 As String, T2 As String, T3 As String, BGC As String, x As Integer

 Dim B As String, I As String, U As String, S As String, sText As String

 With Obj.Interior

  If .ColorIndex &LT;&GT; xlNone And bHG Then

    BGC = ";background-color:#" _

    & Right("0" & Hex(.Color And vbRed), 2) _

    & Right("0" & Hex((.Color And vbGreen) \ &H100), 2) _

    & Right("0" & Hex((.Color And vbBlue) \ &H10000), 2)

  End If

 End With

 S = Obj.Font.Size

 For x = 1 To Len(Obj.Value)

  With Obj.Characters(x, 1).Font

   If .FontStyle Like "*Fett*" And B = "" Then B = "&LT;/b&GT;":            sText = sText & "&LT;b&GT;"

   If .FontStyle Like "*Kursiv*" And I = "" Then I = "&LT;/i&GT;":          sText = sText & "&LT;i&GT;"

   If .Underline = xlUnderlineStyleSingle And U = "" Then U = "&LT;/u&GT;": sText = sText & "&LT;u&GT;"

   If .Underline = xlUnderlineStyleNone And U = "&LT;/u&GT;" Then sText = sText & "&LT;/u&GT;": U = ""

   If Not .FontStyle Like "*Kursiv*" And I = "&LT;/i&GT;" Then sText = sText & "&LT;/i&GT;":    I = ""

   If Not .FontStyle Like "*Fett*" And B = "&LT;/b&GT;" Then sText = sText & "&LT;/b&GT;":      B = ""

   sText = sText & Mid$(Obj.Value, x, 1)

  End With

 Next x

 If U &LT;&GT; "" Then sText = sText & U

 If I &LT;&GT; "" Then sText = sText & I

 If B &LT;&GT; "" Then sText = sText & B

 With Obj.Font

  GetHTML = "&LT;span style='font-size:" & .Size & "pt;font-family:""" _

    & .Name & """;color:#" _

    & Right("0" & Hex(.Color And vbRed), 2) _

    & Right("0" & Hex((.Color And vbGreen) \ &H100), 2) _

    & Right("0" & Hex((.Color And vbBlue) \ &H10000), 2) & BGC _

    & "'&GT;" & Replace(Replace(sText, vbCrLf, "&LT;br&GT;"), vbLf, "&LT;br&GT;") & "&LT;/span&GT;"

 End With

End Function

viele Grüße
Karl-Heinz

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Text in Html für Spalte

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread