Nach unzählige Recherche ich bekomme es leider nicht hin, alle Kommentar in ActiveSheet per VBA automatisch auf Schrift und die Größe anzupassen.
Hier die Beispielsdatei:
https://www.herber.de/bbs/user/97384.xlsm
Es wird in eine Mappe ein Function TakeComment benutzt um die Kommentare in Zeilen/Spalten (E6:K3000) zu schreiben. Der funktioniert gut leider Schrift und Größe lassen sich nicht verändern wie gewünscht. Teilweise steht ein längerer Text und der wird nicht ganz den Text Größen durch Function TakeComment angezeigt.
In Beispielsdatei Tablle1(nicht richtig) und Tabelle2(fast korrekt) kann man den Unterschied sehen.
In Excel Forum fand ich zwei Makros die Schrift Größe (Sub MyFormatAllCommentsArial13) und Text Länge (Sub AutosizeComments)verändern können.
Const maxLength As Long = 35 'Maximale Zeichen pro Zeile
Public Function TakeComment(rngQuelle As Range, Optional rngZiel As Range)
If rngZiel Is Nothing Then
Set rngZiel = Application.Caller
End If
With rngZiel
If Not .Comment Is Nothing Then
.Comment.Delete
End If
If rngQuelle.Value "" Then
.AddComment rngQuelle(1, 1).text
.Comment.Visible = False
TakeComment = "formel"
Else
TakeComment = "leer"
End If
End With
'Call MyFormatAllCommentsArial13
End Function
Sub MyFormatAllCommentsArial13()
Dim com As Comment
Application.ScreenUpdating = False
For Each com In ActiveSheet.Comments
'Schriftzeichen
With com.Shape.TextFrame.Characters.Font
.Bold = True
.ColorIndex = 0
.Name = "Arial"
.Size = 13
End With
Next com
'Call AutosizeComments
Application.ScreenUpdating = True
End Sub
Sub AutosizeComments()
Dim Cell As Range
For Each Cell In ActiveSheet.Cells.SpecialCells(xlCellTypeComments)
With Cell.Comment.Shape.TextFrame
.Characters.text = breakText(.Characters.text, maxLength)
.AutoSize = True
End With
Next
'Call MyFormatAllCommentsArial13
End Sub
Private Function breakText(ByVal text As String, ByVal länge As Long) As String
Dim tmp As String, str As String
Dim lenT As Integer, i As Integer, n As Integer
text = Replace(text, vbLf, " ")
lenT = Len(text)
n = 1
i = 1
Do
tmp = Mid(text, i, länge)
If lenT - i >= länge Then
n = Len(tmp) - InStr(1, StrReverse(tmp), " ") + 1
Else
n = Len(tmp)
End If
str = str & Trim(Left(tmp, n)) & vbLf
i = i + n
Loop While i
Wenn ich die Makros mit Call kombiniere dann dauert es zu lange und manchmal hängt sich Excel.
Wie kann man aus drei 2 Makros und Function TakeComment eine Lösung finden dass z.B. Function TakeComment mir den Kommentar in Schrift Arial 13 und dessen Text an der richtigen Größe anzeigt anpassen?
Weiß jemand, wie man das hinbekommen kann?
Für jeder Hilfe und Hinweise bin ich Euch sehr Dankbar.
Vielen Dank im Voraus.
Daniel