Kommentartext mit "Break" brechen.
26.12.2012 21:43:43
Golem
ich erstelle mit VBA ein Kommentarfeld mit Text.
Kopiertes Tabellenblatt
vor weiterer Bearbeitung
zuerst speichern !
Gespeichert am:
26. Dezember 2012, 21:24:00
mit folgenden Code:
Private Sub CommandButton1_Click()
'Arbeitsblatt kopieren und Verknüpfungen löschen
Dim strQuelldateiPfadName As String
Dim strQuelldateiName As String
Dim wksArbeitsblatt As Worksheet
Dim Dateiname As String
Dim Kommentartext As Comment
Dim strText As String
Dim strDate As String
Dim strFind As String
Dim str1 As String
Dim str2 As String
Dim str3 As String
Dim str4 As String
Dim IBreak As Long
Dim lNum1 As Long
Dim lNum2 As Long
Dim lNumLen As Long
Dim objComment As Comment
strQuelldateiPfadName = ActiveWorkbook.Path + "\" + ActiveWorkbook.Name
strQuelldateiName = ActiveWorkbook.Name
' Bildschirmaktualisierung aus
Application.ScreenUpdating = False
' Arbeitsblatt kopieren
ActiveSheet.Copy
For Each wksArbeitsblatt In ActiveWorkbook.Sheets
' Passwort entsperren
wksArbeitsblatt.Unprotect
Next wksArbeitsblatt
' Verknüpfungen zu anderen Tabellenblättewr werden entfernt
ActiveWorkbook.BreakLink Name:=strQuelldateiPfadName, Type:=xlExcelLinks
For Each wksArbeitsblatt In ActiveWorkbook.Sheets
' Blattschutz aufheben
wksArbeitsblatt.EnableSelection = xlUnlockedCells
Next wksArbeitsblatt
' Button löschen
ActiveSheet.DrawingObjects(1).Delete
' Kommentartext für Zelle T4
str1 = "Kopiertes Tabellenblatt"
str2 = "vor weiterer Bearbeitung"
str3 = "zuerst speichern !"
str4 = "Gespeichert am:"
' Datums- und Zeitformat
strDate = "dd. mmmm yyyy, hh:mm:ss"
' ist ein Kommentar in der Zelle T4...
If Not Range("T4").Comment Is Nothing Then
' dann löschen
Range("T4").Comment.Delete
End If
' neuen Kommentar erstellen und Formatieren
Set Kommentartext = ActiveSheet.Range("T4").AddComment
Kommentartext.Text Text:=Format(Now, strDate) & Chr(10)
With Kommentartext
'Kommentartext für Zelle T4
Kommentartext.Text Text:=str1 & Chr(10) & str2 & Chr(10) _
& str3 & Chr(10) & Chr(10) & str4 & Chr(10) & Format(Now, strDate)
' find the line break and markers
lBreak = InStr(1, Kommentartext.Text, Chr(10))
lNum1 = InStr(1, Kommentartext.Text, strFind) + 1
lNum2 = InStr(lBreak, Kommentartext.Text, strFind) + 1
With Kommentartext.Shape.TextFrame
'Erster Kommentartext in Farben rot ( ab erstes Zeichen und bis zum ersten Bruch ( 24 Zeichen lang ))
.Characters(1, IBreak).Font.ColorIndex = 3
'Zweiter Kommentartext in Farben rot ( ab 25. Zeichen und bis zum zweiten Bruch ( 24 Zeichen lang ))
.Characters(lBreak + 1, lBreak).Font.ColorIndex = 3
'Dritter Kommentartext in Farben rot ( ab 50. Zeichen und 18 Zeichen lang )
.Characters(50, 18).Font.ColorIndex = 3
'Vierter Kommentartext in Farben blau ( ab 69. Zeichen und 18 Zeichen lang )
.Characters(69, 16).Font.ColorIndex = 5
'Datums- und Zeitformat als Restzeichen in schwarz
.Characters(86, 27).Font.ColorIndex = 0
End With
Die ersten beiden Textzeilen bekomme ich mit "IBreak" dargestellt ( .Characters(1, IBreak). und .Characters(lBreak + 1, lBreak) ).
Die weiteren Textzeilen bekomme ich nur mit Anzahl der Zeichen dargestellt.
Wie könnten die Textzeilen drei bis fünf mit "Break" dargestellt werden?
Schöne Grüße
Golem