Unterstreichung in Markup verwandeln

25/08/2008 - 08:22 von Butenbremer | Report spam
Hallo,
ich habe eine Exceltabelle, die u.a. in einer Spalte Texte enthàlt.
Innerhalb dieser Texte gibt es Unterstreichungen. Diese möchte ich ein
ein Markup verwandeln um Anfang und Ende der Unterstreichung zu
kennzeichnen (und spàter auf die Unterstreichung verzichten zu können,
gewünschtes Resultat z.B. "Das Krokodil hat <UNTERSTR>Hunger</
UNTERSTR>").
Ich vermute, dass dies mit VBA zu realisieren ist, ich habe aber zu
wenig Ahnung, wie diese Lösung konkret aussieht. Bin für jede Hilfe
dankbar!

Gruß
 

Lesen sie die antworten

#1 Michael Franke
30/08/2008 - 17:15 | Warnen spam
Hallo Butenbremer,

Hallo,
ich habe eine Exceltabelle, die u.a. in einer Spalte Texte enthàlt.
Innerhalb dieser Texte gibt es Unterstreichungen. Diese möchte ich ein
ein Markup verwandeln um Anfang und Ende der Unterstreichung zu
kennzeichnen (und spàter auf die Unterstreichung verzichten zu können,
gewünschtes Resultat z.B. "Das Krokodil hat <UNTERSTR>Hunger</
UNTERSTR>").



so könnte es funktionieren (wobei das Beispiel von den Zellen A1 bis
A3 im Tabellenblatt Tabelle1 ausgeht, deren Texteintràge nach Belieben
unterstrichen sind; der "neue" Text wird in die rechts angrenzende
Zelle geschrieben):

Sub Unterstreichen()
Dim rngZelle As Range
Dim rngBereich As Range
Dim intLànge As Integer
Dim intZàhler As Integer
Dim bolUnterstrich As Boolean
Dim strTextNeu As String
Const strUnterAnfang = "<UNTERSTR>"
Const strUnterEnde = "</UNTERSTR>"
Set rngBereich = Sheets("Tabelle1").Range("A1:A3")
For Each rngZelle In rngBereich
intLànge = Len(rngZelle)
If intLànge > 0 Then
intZàhler = 1
bolUnterstrich = False
strTextNeu = ""
Do
If bolUnterstrich = False Then
If Not rngZelle.Characters(intZàhler,
1).Font.Underline = xlUnderlineStyleNone Then
bolUnterstrich = True
strTextNeu = strTextNeu &
strUnterAnfang & rngZelle.Characters(intZàhler, 1).Text
Else
strTextNeu = strTextNeu &
rngZelle.Characters(intZàhler, 1).Text
End If
Else
If Not rngZelle.Characters(intZàhler,
1).Font.Underline = xlUnderlineStyleNone Then
strTextNeu = strTextNeu &
rngZelle.Characters(intZàhler, 1).Text
Else
bolUnterstrich = False
strTextNeu = strTextNeu & strUnterEnde
& rngZelle.Characters(intZàhler, 1).Text
End If
End If
intZàhler = intZàhler + 1
Loop Until intZàhler > intLànge
If bolUnterstrich = True Then strTextNeu = strTextNeu &
strUnterEnde
End If
rngZelle.Offset(0, 1).Value = strTextNeu
Next
Set rngBereich = Nothing
End Sub

Gruß, Michael

Ähnliche fragen