Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1208to1212
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Formatierung .IndentLevel = 1 im Code einfügen

Formatierung .IndentLevel = 1 im Code einfügen
Karel
Hallo Forum,
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
AW: Formatierung .IndentLevel = 1 im Code einfügen
18.04.2011 07:31:26
fcs
Hallo Karel,
wenn ich mich richtig erinnere, dann wird mit dem Makro der Text aus einer Userform-Textbox in die Zelle eines Tabellenblatts eingetragen. Dabei werden einzelne Zeichen oder Zeilen des Zellinhaltes besonders formatiert.
Mit der Einzugs-Formatierung wird der gesamte Zellinhalt eingezogen. Diese Formatierung kann nicht auf einzelne Zeilen des Zellinhalts angewendet werden. Als Sonderlösung müßten hier Leerzeichen eingefügt werden.
Für die Formatierung der Zeilen mit Zeichen 149 am Zeilenbeginn müßte etwas ähnlich kompliziertes wie für die Fettformatierung eingerichtet werden. Nämlich ein weiteres 2-spaltiges Array in dem jeweils das 1. und letzte Zeichen der Textabschnitte gespeichert wird. Da sich die Fettformatierung mit dieser Formatierung überlagern kann müssen auch diese Sonderfälle irgendwie berücksichtigt werden. So wird das ganze ziemlich kompliziert.
Du solltest dir also überlegen, ob dies wirklich unbedingt so umsetzen willst.
Gruß
Franz
Anzeige
AW: Formatierung .IndentLevel = 1 im Code einfügen
18.04.2011 09:44:14
kareä
Hallo Franz,
Ja, stimmt ist für Userform-Textbox ich hatte schon probiert wie bei
'Prüfen, ob "ü " am Zeilenanfang
If Left(arrText(iI), 2) = "ü " Then
und dass umzubauen für Zeichen 149 mit Einzug da im Prinzipe ist das das gleiche. Aber leider bekomm ich dass nicht auf der reihe, bin nicht weiter gekommen als Einzug auf gesamte Zellinhalt. Für mich währe wichtig, abgesehen von Einzug dass ich betreffende Schriftfarbe kann ändere.
möchte eine Lösung möglich sein sollte das schön sein
Grüße
Karel
AW: Formatierung Zeile nur noch Chr (149)
18.04.2011 20:34:27
Karel
Hallo Forum,
So theme Einzug hat sich erledigt, das einigste wass noch wichtig ist,
ist Formatierung alle Zeile die zeichen Chr (149) haben '"# " ersetzen durch "• " mit
.Size = 9
.ColorIndex = 10
Gruss,
Karel
Anzeige
AW: Formatierung Zeile nur noch Chr (149)
18.04.2011 21:54:10
fcs
Hallo Karel,
hier der angepasste Code. Neue und geänderte Code-Zeilen sind gekennzeichnet.
Gruß
Franz
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 Arr149() As Long, iL As Long                     'neu 20110418
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                 'neu 20110418 -Anfang
If Left(arrText(iI), 2) = Chr(149) & " " Then
iL = iL + 1
ReDim Preserve Arr149(1 To 2, 1 To iL)
'Position des •
Arr149(1, iL) = Len(sZelle) + 1
'Länge des Textes bis zum Zeilenende
Arr149(2, iL) = Len(arrText(iI)) - IIf(InStr(1, arrText(iI), sSonderzeichen) > 0, 1, 0) _
End If                                           'neu 20110418 -Ende
'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
'Zeilen mit Zeichen • am Anfang formatieren                 'neu 20110418 -Anfang
For iI = 1 To iL
With .Characters(Start:=Arr149(1, iI), Length:=Arr149(2, iI)).Font
.Size = 9
.ColorIndex = 10
End With
Next                                                         'neu 20110418 -Ende
'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 'geändert 20110418
.Characters(Start:=ArrWing(iI), Length:=1).Font.Bold = True
Next
.RowHeight = 100
End With
'  Unload Me
End Sub

Anzeige
AW: Danke ist richtig toll Owt
18.04.2011 22:38:29
Karel
Hallo Franz,
Danke vom Herze,
Gruss
Karel
Kleine nachtrag Problem Leerzeichen
20.04.2011 02:47:58
Karel
Hallo Franz,
habe festgestellt wenn ich erst leerzeichen eingeben im Textbox und dan '"# " ersetzen durch "• "
klappt es leider mit Formatierung nicht. Kann man dass noch abfangen?
• test ' Formatierung ohne Problem wenn "•" am anfang Zeile
• test ' Formatierung ohne Problem wenn "•" am anfang Zeile
aber nach Manuelle Leerzeichen (Einzug) im User Textbox
" " • test ' Formatierung Problem wenn erst " " Leerzeichen am anfang Zeile und anschließend "•"
" " • test ' Formatierung Problem wenn erst " " Leerzeichen am anfang Zeile und anschließend "•"
dann Formatierung Problem
'Zeilen mit Zeichen • am Anfang formatieren 'neu 20110418 -Anfang
For iI = 1 To iL
With .Characters(Start:=Arr149(1, iI), Length:=Arr149(2, iI)).Font
.Size = 9
.ColorIndex = 10
End With
Grüße
Karel
Anzeige
AW: Kleine nachtrag Problem Leerzeichen
21.04.2011 01:20:23
fcs
Hallo Karel,
passe den folgenden Abschnitt des Makros an:
       'Prüfen, ob "# " am Zeilenanfang bzw. in 1. fünf Zeichen der Zeile (max. 3 Leerzeichen  _
vor #)
If InStr(1, Left(arrText(iI), 5), "# ") > 0 Then
'"# " ersetzen durch "• "
arrText(iI) = VBA.Replace(Left(arrText(iI), 5), "# ", Chr(149) & " ") _
& IIf(Len(arrText(iI)) > 5, Mid(arrText(iI), 6), "")
End If
'Prüfen, ob "• "  am Zeilenanfang bzw. in 1. fünf Zeichen der Zeile (max. 3 Leerzeichen  _
vor •)
If InStr(1, Left(arrText(iI), 5), Chr(149) & " ") > 0 Then
iL = iL + 1
ReDim Preserve Arr149(1 To 2, 1 To iL)
'Position des 1. Zeichens der Zeile
Arr149(1, iL) = Len(sZelle) + 1
'Länge des Textes bis zum Zeilenende
Arr149(2, iL) = Len(arrText(iI)) - IIf(InStr(1, arrText(iI), sSonderzeichen) > 0, 1, 0) _
End If
Gruß
Franz
Anzeige
AW: Kleine nachtrag Problem Leerzeichen Owt
22.04.2011 07:28:20
Karel
Hallo Franz,
Jetzt geht ess, herzliche dank und ein Frohes Ostern.
Gruße
Karel

302 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige