Fontfarbe in Kommentar - unplausible Fehlermeldung
27.10.2013 02:35:16
Johann
hab schon diverseste Foren durchgeackert und hänge schon 6 Stunden an diesem Problem.
Ich benötige wohl den Blick von außen auf mein Problem:
Ich möchte zu einem formatierten Kommentar einen weiteren Text mit anderer Formatierung dazuhängen. Das funktioniert auch einmal, aber beim zweiten Aufruf der selben Funktion bekomme ich bei der Umstellung des Farb-Indexes eine Fehlermeldung
"Schriftgrad muss zwischen 1 und 409 Punkten liegen".
Nachfolgend mein Code, welcher beim zweiten Aufruf von "Comment_AddFormattedText" in besagten Fehler läuft. Dabei funktioniert vorher die Umstellung des Colorindex insgesamt schon dreimal ....
Ich verstehe es nicht mehr... aber vielleicht einer von Euch Guru's
Vielen Dank im Voraus für konstruktive Hinweise!
Liebe Grüße aus Wien
Option Explicit
Sub Comment_Format_Test1()
Dim WB1 As Boolean
If Not ActiveCell.Comment Is Nothing Then ActiveCell.Comment.Delete
ActiveCell.AddComment "1...5...10....5...20"
ActiveCell.Comment.Shape.TextFrame.Characters.Font.Name = "Arial"
ActiveCell.Comment.Shape.TextFrame.Characters.Font.Size = 8
ActiveCell.Comment.Shape.TextFrame.Characters.Font.ColorIndex = 3 '1=Schwarz 2=Weiss 3=Rot 4= _
_
Gruen 5=Blau 6=Gelb 7=Magenta
ActiveCell.Comment.Shape.TextFrame.Characters(1, 5).Font.ColorIndex = 7 ' Characters 1 - 5 in _
_
Magenta
ActiveCell.Comment.Shape.TextFrame.Characters(6, 5).Font.ColorIndex = 5 ' Char 6 - 10 in Blau
ActiveCell.Comment.Shape.TextFrame.Characters(6, 5).Font.Underline = True
ActiveCell.Comment.Shape.TextFrame.Characters.Font.Bold = True
ActiveCell.Comment.Shape.TextFrame.Characters.Font.Underline = True
' Formatting comment box
ActiveCell.Comment.Shape.AutoShapeType = msoShapeRoundedRectangle
ActiveCell.Comment.Shape.Fill.Visible = msoTrue
ActiveCell.Comment.Shape.Fill.ForeColor.RGB = RGB(9, 255, 255) 'Cyan als Kommentar-Hintergrund
ActiveCell.Comment.Shape.Fill.Patterned msoPatternHorizontalBrick
' Dieser Aufruf funktioniert ohne Probleme:
WB1 = Comment_AddFormattedText(ActiveCell, vbCrLf & "Hinzufueg1", "Arial", 10, False, False, _
False, 1)
' Innerhalb dieses Aufrufes kommt der Fehler
WB1 = Comment_AddFormattedText(ActiveCell, vbCrLf & "Hinzufueg2", "Arial", 10, False, False, _
False, 4)
WB1 = Comment_AddFormattedText(ActiveCell, vbCrLf & "Hinzufueg3", "Arial", 10, False, False, _
False, 3)
End Sub
'#################################################################################
' Formatierten Text zu einem kommentar hinzufügen
'
'
Function Comment_AddFormattedText(ByRef Zelle As Range, _
AddText As String, _
WFontName As String, _
WFontSize As Integer, _
WFontBold As Boolean, _
WFontUnderline As Boolean, _
WFontStrikeThrough As Boolean, _
WFontColorIndex As Integer) As Boolean
Dim BegChar As Integer
Dim TxtLen As Integer
Dim OldLen As Integer
Dim NewStart As Integer
Dim RetWt As Boolean
RetWt = True
TxtLen = Len(AddText)
If TxtLen 0 Then
.Font.ColorIndex = WFontColorIndex
End If
If Trim$(WFontName) "" Then
.Font.Name = WFontName
End If
If WFontSize 0 Then
.Font.Size = WFontSize
End If
.Font.Underline = WFontUnderline
.Font.Bold = WFontBold
.Font.Strikethrough = WFontStrikeThrough
End With
Comment_AddFormattedText = False
Exit Function
Comm_AddFormTxt_Err:
MsgBox "Fehler aufgetreten", vbOKOnly, "Fehler in Funktion aufgetreten"
Exit Function
End Function