Microsoft Excel

Herbers Excel/VBA-Archiv

fette, kursive etc. Zeichen umwandeln!

Betrifft: fette, kursive etc. Zeichen umwandeln! von: Brezo
Geschrieben am: 15.09.2004 09:23:56

Hallo,
ich habe in excel/vba folgendes Problem:
ich habe in einer Range, welche ich in einer schleife zelle für zelle durchgehe,
in manchen zellen wörter, oder einzelne buchstaben in einem wort, welche fett, kursiv etc. formatiert sind. Nun möchte ich diese Wörter oder Zeichen auf standart formatieren aber gleichzeitig außenrum die zeichen hinschreiben lassen, welche den html tag für z.b. fett wiederspiegeln, ein Beispiel:

Hallo dies ist ein Test.

Das Makro soll nun folgendes an die Stelle in der Zelle schreiben:

Hallo dies ist <.b.>ein<./b.> Test.

"ein" ist nun nicht mehr fett (Punkte wegdenken)

So ein ähnliches Spiel betreibe ich mit zeilenumbrüche, welche ich durch <.br.> ersetze, was ich durch die replace funktion realisiere, was vollständig so aussieht:

Dim wks As Worksheet
Dim xArray As Variant
Dim xRow&
Dim xCol&

With Worksheets("Katalog")
Set wks = Worksheets("Katalog")
xArray = wks.Range(wks.Cells(6, kurzbeschr_col), wks.Cells(LastRow, ausfbeschr_col)).Value
For xRow = LBound(xArray, 1) To UBound(xArray, 1)
For xCol = LBound(xArray, 2) To UBound(xArray, 2)
xArray(xRow, xCol) = Replace(xArray(xRow, xCol), Chr(10), "<.br.>", 1, -1, 0)
xArray(xRow, xCol) = Replace(xArray(xRow, xCol), Chr(13), "<.br.>", 1, -1, 0)
Next
Next
wks.Range(wks.Cells(6, kurzbeschr_col), wks.Cells(LastRow, ausfbeschr_col)).Value = xArray '
End With

Nun weiss ich aber nicht ob mir replace bei formatierungen wie anfangs beschrieben weiterhelfen kann oder nicht. Oder wie ich ansonsten das Problem lösen kann.
Weiss jemand Rat?

  


Betrifft: AW: fette, kursive etc. Zeichen umwandeln! von: Reinhard
Geschrieben am: 15.09.2004 15:57:25

Hi Brezo,
pobiers mal so:
Sub Makro2()
For Each Zelle In Worksheets("Tabelle1").Range("A1:B10")
    For n = 1 To Len(Zelle.Value)
        If Zelle.Characters(n, 1).Font.FontStyle = "Fett" Then
            Wort = ""
            p = n
            While Zelle.Characters(p, 1).Font.FontStyle = "Fett"
                Wort = Wort + Zelle.Characters(p, 1).Text
                p = p + 1
            Wend
            Zelle.Value = Left(Zelle.Value, n - 1) & "<b>" & Wort & "</b>" & Mid(Zelle.Value, p + 1)
            n = p - 1
        End If
    Next n
    Zelle.Value = Replace(Zelle.Value, Chr(10), "<br>")
Next Zelle
End Sub

Gruß
Reinhard


 

Beiträge aus den Excel-Beispielen zum Thema "fette, kursive etc. Zeichen umwandeln!"