AW: Text formatieren
15.09.2015 09:55:05
Alfons
Hallo Mike,
Public Sub Format_Text()
Dim strOrg As String, strRes As String, strSB As String
Dim arr
Dim x As Integer, pos As Integer
Dim rng As Range
For Each rng In Selection
strOrg = rng.Value
If Len(strOrg) > 0 Then
strSB = "<INFO"
strRes = Replace(strOrg, strSB, Chr(10) & strSB)
strSB = "</INFO-CUSTOMER>"
strRes = Replace(strRes, strSB, strSB & Chr(10))
'letzten Umbruch entfernen
strRes = Mid(strRes, 1, Len(strRes) - 1)
'MsgBox strRes
'an verbleibenden Umbrüchen aufteilen
arr = Split(strRes, Chr(10), -1, vbTextCompare)
With Cells(rng.Row, rng.Column + 1) 'rechts schreiben
'With rng 'Original überschreiben
.Clear
.Value = strRes
pos = 1
For x = 0 To UBound(arr)
'die fetten Teile:
If InStr(1, arr(x), strSB, vbTextCompare) = 0 Then
.Characters(Start:=pos, Length:=Len(arr(x))).Font.FontStyle = "Fett"
End If
pos = pos + Len(arr(x))
Next x
End With
End If
Next rng
End Sub
Gruß
Alfons
-------------------------------------------------------------------
http://vba1.de
-------------------------------------------------------------------