Ich möchte gerne unterstehende Code ergänzen mit bestimmte Formatierung
Wenn Charakter Chr(149) dann Einzug = 1, Size und Colorindex
Komme selber nicht weiter!
.IndentLevel = 1
.Size = 9
.ColorIndex = 10
Betreffend Teil Fett markiert
Private Sub CommandButton1_Click() '***Code vom Tino
'Einfügen-Button
Dim arrText, iI As Long, Laenge1 As Long
Dim ArrFett() As Long, iJ As Long
Dim ArrWing() As Long, iK As Long
Dim Zelle As Range, sZelle As String
Set Zelle = ActiveCell
sZelle = TextBox1.Text
'Steuerzeichen 13 im Text entfernen/ersetzen
sZelle = VBA.Replace(sZelle, Chr(13), "")
'Textboxtext an Zeilenschaltungen splitten
arrText = Split(sZelle, Chr(10))
sZelle = ""
'Text für Zelle zusammenfügen und Positionen der fett zu formatierenden _
Textteile und der als Wingding zu formatierenden Texte ermitteln
For iI = LBound(arrText) To UBound(arrText)
If iI > LBound(arrText) Then
'ab 2. Zeile, Zeilenschaltung vor dem Text einfügen
sZelle = sZelle & Chr(10)
End If
'Prüfen, ob "# " am Zeilenanfang
If Left(arrText(iI), 2) = "# " Then
'"# " ersetzen durch " "
arrText(iI) = Chr(149) & " " & Mid(arrText(iI), 3)
End If
'Prüfen, ob "ü " am Zeilenanfang
If Left(arrText(iI), 2) = "ü " Then
'Position merken für Wingdings-Formatierung
iK = iK + 1
ReDim Preserve ArrWing(1 To iK)
ArrWing(iK) = Len(sZelle) + 1
End If
'Prüfen, ob Sonderzeichen "'" im Text
If InStr(1, arrText(iI), sSonderzeichen) > 0 Then
iJ = iJ + 1
ReDim Preserve ArrFett(1 To 2, 1 To iJ)
'Position des Sonderzeichens
ArrFett(1, iJ) = Len(sZelle) + InStr(1, arrText(iI), sSonderzeichen)
'Länge des Textes bis zum Zeilenende
ArrFett(2, iJ) = Len(arrText(iI)) - InStr(1, arrText(iI), sSonderzeichen)
'Text vor und nach dem Sonderzeichen zum Zelltext hinzufügen
sZelle = sZelle & Left(arrText(iI), InStr(1, arrText(iI), sSonderzeichen) - 1) _
& Mid(arrText(iI), InStr(1, arrText(iI), sSonderzeichen) + 1)
Else
'Text zum Zelltext hinzufügen
sZelle = sZelle & arrText(iI)
End If
If iI = LBound(arrText) Then
'Länge Text in 1. Zeile
Laenge1 = Len(sZelle)
End If
Next
With Zelle
'Text ohne Sonderzeichen einfügen
.Value = sZelle
'Schrift-Formatierung der Zelle zurücksetzen
With .Font
.Bold = False ' nicht fett
.Name = "Calibri" 'Font
.ColorIndex = 1
.Size = 11
End With
'1. Zeile formatieren
With .Characters(Start:=1, Length:=Laenge1).Font
.Bold = True
.Size = 20
.ColorIndex = 10
End With
'ggf. Textabschnitte fett formatieren
For iI = 1 To iJ
.Characters(Start:=ArrFett(1, iI), Length:=ArrFett(2, iI)).Font.Bold = True
Next
'ggf. Textabschnitte als Wingdings formatieren
For iI = 1 To iK
.Characters(Start:=ArrWing(iI), Length:=1).Font.Name = "Wingdings"
.Characters(Start:=ArrWing(iI), Length:=1).Font.ColorIndex = "10"
.Characters(Start:=ArrWing(iI), Length:=1).Font.Bold = True
Next
.RowHeight = 100
End With
' Unload Me
End Sub
Gruße
Karel