Makro für Kommentarfeld Schrift und Text Größe anp

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Frame
Bild

Betrifft: Makro für Kommentarfeld Schrift und Text Größe anp
von: Becker
Geschrieben am: 30.04.2015 14:26:36

Hallo lieber Experten,
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.

  • 'Option Explicit
    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 < lenT
         breakText = Left(str, Len(str) - 1)
     End Function


  • 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

    Bild

    Betrifft: Makro für Kommentarfeld Schrift und Text Größe anp
    von: Klexy
    Geschrieben am: 30.04.2015 17:10:30
    So richtig klar formuliert ist dein Anliegen nicht. z.B. Schriftgröße oder Feldgröße?
    Zitat: "und dessen Text an der richtigen Größe anzeigt anpassen" ???
    Vielleicht hilft dir das weiter?

    Sub Bla()
    For Each Cell In ActiveSheet.UsedRange
        On Error Resume Next
        
        Set myCom = Cell.Comment
            myCom.Text Text:="bla"
            
            myCom.Shape.Select
            With Selection.Font
                .Name = "Arial"
                .FontStyle = "Fett"
                .Size = 13
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ColorIndex = 3
                .TintAndShade = 0
                .ThemeFont = xlThemeFontNone
            End With
            
            myCom.Shape.Width = 300
            myCom.Shape.Height = 100
            
            myCom.Shape.Top = myCom.Parent.Top + 1
            myCom.Shape.Left = myCom.Parent.Offset(0, 1).Left + 10
                        
    Next Cell
    End Sub


    Bild

    Betrifft: AW: Makro für Kommentarfeld Schrift und Text Größe anp
    von: Becker
    Geschrieben am: 30.04.2015 21:28:31
    Hallo Klexy,
    Vielen Dank für Dein Hinweis. Dein Makro löscht die vorhanden Kommentare und ersetzt ins leere Kommentare mit Beispiels Text „bla“ um. Sorry für meine fehlende Beschreibung, das wollte ich eben nicht.
    Gemeint habe ich Schriftgöße 13, Fett Format und die Größe wäre optimal abhänging von den Zeillen Inhalt (E10:K12).
    Also der Text der sich in Zeilen (E10:K12) befindet der soll als Kommentar in Zeillen (E13:K15) angezeigt werden. Das passiert mit der Formel „=WENN(E12="";"";TakeComment(E12;E15))“.
    Im Grunde genommen gepostete 2 Makros :
    1.Kommentar auf Schrift Größe Araial 13 („Sub MyFormatAllCommentsArial13“)
    2. Automatische Text Länge („Sub AutosizeComments“) sowie
    3. „Function TakeComment“ machen das gesuchte Ergenis sehr langsam und bremsen Excel voll.
    Das passiet nur wenn ich die Makros mit „Call...“ verbiende.
    Wenn ich „Sub MyFormatAllCommentsArial13“ und Sub „AutosizeComments“ getrennt ausführe dann habe ich die gewünschte Ergenisse. Sobald die Mappe neu berechnet wird springen die Kommentare auf ursprung Format (wegen „Function TakeComment“ = kleiner Schfift und man sieht nur 5 Zeilen in Kommentar). Ab und zu sind Texte viel länger und man sieht nicht in den Kommentar ganzen Text und man müsste dessen Kommentare manuel vergrößern.
    Einfacher gesagt wenn man Public „Function TakeComment“ her nimmt wie kann man die Befehle aus „Sub MyFormatAllCommentsArial13“ und „Sub AutosizeComments“ zusammen verbinden oder neu schreiben?
    Oder wie kann man den Makro „Function TakeComment“ so umändern das er genommen Text aus (E10:K12) durch die Formel „=WENN(E12="";"";TakeComment(E12;E15))“ ins Zeilen (E13:K15) überträgt/reinschreibt. Dabei solle das Kommentar Arial Größe 13 und Fett Fromat haben. Kommentar Größe wäre am besten automatiasch sich den Text Größen anzupassen.
    Probiert habe ich auch mit:

    
    Const maxLength As Long = 35
     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 < lenT
         breakText = Left(str, Len(str) - 1)
     End Function
    
    aber leider da hebe ich zu wenig Ahnung es alleine umzuändern.
    Hoffentlich war ich diesmal mehr veständlicher.
    Veien Dank Klexy
    Daniel

    Bild

    Betrifft: AW: Makro für Kommentarfeld Schrift und Text Größe anp
    von: Klexy
    Geschrieben am: 02.05.2015 11:18:02
    Von deinen Makros brauchst du jetzt nur noch breaktext.

    Sub bla()
    Dim bla As String
    For Each Cell In ActiveSheet.UsedRange
    Cell.Select
    bla = Cell.Offset(-3, 0).Value
        On Error Resume Next
        
        Set myCom = Cell.Comment
            myCom.text text:=bla
            
           If Not myCom Is Nothing = True Then
            myCom.Shape.Select
            With Selection.Font
                .Name = "Arial"
                .FontStyle = "Fett"
                .Size = 13
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ColorIndex = 3
                .TintAndShade = 0
                .ThemeFont = xlThemeFontNone
            End With
            
            With myCom.Shape.TextFrame
                 .Characters.text = breakText(.Characters.text, maxLength)
                 .AutoSize = True
             End With
            
            myCom.Shape.Top = myCom.Parent.Top + 1
            myCom.Shape.Left = myCom.Parent.Offset(0, 1).Left + 10
            Else
            End If
                        
    Next Cell
    End Sub


    Bild

    Betrifft: AW: Makro für Kommentarfeld Schrift und Text Größe
    von: Becker
    Geschrieben am: 04.05.2015 13:23:35
    Hallo Klexy,
    Sorry dass ich mich so spät erst melde.
    Vielen Dank für Deiner Hilfe. Die Lösung fand ich interessant aber leider das ist nicht die gesuchte Lösung.
    Noch einmal zur mein Anliegen. Ich habe eine Tabelle in der sich sehr viele Kommentare (Zeilen/Spalten E6:K3000) befinden. Gesucht habe ich per VBA Format für Kommentar Fenster. Damit meinte ich Fett Format „Arial 13“ und automatische Kommentarfenster Größe der sich zur Text Größe anpasst.
    Gestoßen bin ich auf noch eine Lösung die mir jetzt geholfen hat von:
    http://www.office-loesung.de/ftopic522380_0_0_asc.php

    Option Explicit 
     Private Declare Function KillTimer Lib "user32.dll" ( _ 
         ByVal hWnd As Long, _ 
         ByVal nIDEvent As Long) As Long 
     Private Declare Function SetTimer Lib "user32.dll" ( _ 
         ByVal hWnd As Long, _ 
         ByVal nIDEvent As Long, _ 
         ByVal uElapse As Long, _ 
         ByVal lpTimerFunc As Long) As Long 
     Private lstrAddress As String 
     Public Function TakeComment(strSource As String, Optional rngTarget As Range) As String 
         If rngTarget Is Nothing Then 
             Set rngTarget = Application.Caller 
         End If 
         With rngTarget 
             If Not .Comment Is Nothing Then 
                 .Comment.Delete 
             End If 
             With .AddComment 
                 .Text strSource 
                 .Visible = False 
             End With 
             lstrAddress = .Address 
         End With 
         Call SetTimer(Application.hWnd, 0, 1, AddressOf TimerProc) 
     End Function 
     Public Sub FormatComment() 
         With Range(lstrAddress).Comment.Shape.TextFrame 
             .AutoSize = True 
             With .Characters.Font 
                 .Name = "Arial" 
                 .Bold = False 
                 .Size = 10 
             End With 
         End With 
     End Sub 
     Private Sub TimerProc(ByVal hWnd As Long, ByVal nIDEvent As Long, _ 
         ByVal uElapse As Long, ByVal lpTimerFunc As Long) 
         On Error Resume Next 
         Call KillTimer(Application.hWnd, 0) 
         Call FormatComment 
     End Sub
    Falls noch jemand so was suchen würde meiner angepasste Lösung (für 32 & 64 Bit Version)sieht jetzt so aus:
    'Option Explicit
    ''32 Bit Version'32 Bit Version'32 Bit Version'32 Bit Version
    ''Private Declare Function KillTimer Lib "user32.dll" ( _
         ByVal hWnd As Long, _
         ByVal nIDEvent As Long) As Long '32 Bit Version
     ''Private Declare Function SetTimer Lib "user32.dll" ( _
         ByVal hWnd As Long, _
         ByVal nIDEvent As Long, _
         ByVal uElapse As Long, _
         ByVal lpTimerFunc As Long) As Long '32 Bit Version
    ''32 Bit Version'32 Bit Version'32 Bit Version'32 Bit Version
    '''64Bit Version'64Bit Version'64Bit Version
     Const maxLength As Long = 55    'Maximale Zeichen pro Zeile
     
    Private Declare PtrSafe Function SetTimer Lib "user32.dll" ( _
        ByVal hWnd As LongPtr, _
        ByVal nIDEvent As LongPtr, _
        ByVal uElapse As LongPtr, _
        ByVal lpTimerFunc As LongPtr) As Long '64Bit Version
        
    Private Declare PtrSafe Function KillTimer Lib "user32.dll" ( _
        ByVal hWnd As LongPtr, _
        ByVal nIDEvent As LongPtr) As Long '64Bit Version
    '''64Bit Version'64Bit Version'64Bit Version
    Private lstrAddress As String
     Public Function TakeComment(strSource As String, Optional rngTarget As Range) As String
         If rngTarget Is Nothing Then
             Set rngTarget = Application.Caller
         End If
         With rngTarget
             If Not .Comment Is Nothing Then
                 .Comment.Delete
             End If
             With .AddComment
                 .text strSource
                 .Visible = False
             End With
             lstrAddress = .Address
         End With
         Call SetTimer(Application.hWnd, 0, 1, AddressOf TimerProc)
         'Call FormatComment
     End Function
     Public Sub FormatComment()
         With Range(lstrAddress).Comment.Shape.TextFrame
             .AutoSize = False
             With .Characters.Font
                 .Name = "Arial"
                 .ColorIndex = 0
                 .Bold = True
                 .Size = 14
             End With
         End With
         Call CommentSizeFasterCellAdjusting
     End Sub
     Private Sub TimerProc(ByVal hWnd As Long, ByVal nIDEvent As Long, _
         ByVal uElapse As Long, ByVal lpTimerFunc As Long)
         On Error Resume Next
         Call KillTimer(Application.hWnd, 0)
         'Call FormatComment
         Call MyFormatAllCommentsArialBlue13
     End Sub
     
     
     Sub CommentSizeFasterCellAdjusting()
     Dim C As Comment
     For Each C In ActiveSheet.Comments
     C.Shape.Width = 280
     C.Shape.Height = Len(C.text) * 2
     Next C
     End Sub
     Sub MyFormatAllCommentsArialBlue13()
        Dim com As Comment
        
        Application.ScreenUpdating = False
        
        For Each com In ActiveSheet.Comments
        'Schriftzeichen
        With com.Shape.TextFrame.Characters.Font
            .Bold = True
            .ColorIndex = 0 '5=Blau,3=Rot, 4=Grün,1=Schwarz, 2=Weiß
            .Name = "Arial"
            .Size = 13
        End With
        Next com
         'Call CommentSizeFasterCellAdjusting
        Application.ScreenUpdating = True
        Call CommentSizeFasterCellAdjusting
    End Sub

    Vielen Dank noch einmal
    Daniel

    Bild

    Betrifft: AW: Makro für Kommentarfeld Schrift und Text Größe
    von: Klexy
    Geschrieben am: 04.05.2015 19:14:49
    Und was anderes macht mein Makro, nur viel kürzer und unkomplizierter?

    Bild

    Betrifft: AW: Makro für Kommentarfeld Schrift und Text Größe
    von: Becker
    Geschrieben am: 04.05.2015 22:41:56
    Hallo Klexy,
    Vielen Dank für Deine Hilfe. Dein Makro ist kürzer und den habe ich mir gespeichert (falls ich so eine Lösung gebrauchen werde). Dein Makro formatiert Kommentare und den Zeilen Inhalt. Vor allem wenn es sich um Zeilen Inhalt("E6:K3000", oder "ActiveSheet")handelt dann dauert Dein Lösungsvorschlag über einigen Minuten (was verständlich ist bei dessen Zeilen Anzahl).
    Hier Dein Lösungsvorschlag:
    Userbild
    Ich will nicht Dein Lösungsvorschlag widersprechen daher teilte ich nur mein gewünschter Lösung die ich im Internet gefunden habe.
    Userbild
    Gefunden Lösung aus Internet hat mir besser gefallen und vor allem beim Spalten/Zeilen Anzahl ("E6:K3000" oder "ActiveSheet") funktioniert es viel schneller bei mir (weniger als 1 Minute).
    LG und vielen Dank nochmal Klexy
    Daniel


     Bild

    Beiträge aus den Excel-Beispielen zum Thema "Makro für Kommentarfeld Schrift und Text Größe anp"