Anzeige
Archiv - Navigation
1420to1424
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

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

Makro für Kommentarfeld Schrift und Text Größe anp
30.04.2015 14:26:36
Becker
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 


  • 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

    6
    Beiträge zum Forumthread
    Beiträge zu diesem Forumthread

    Betreff
    Datum
    Anwender
    Anzeige
    Makro für Kommentarfeld Schrift und Text Größe anp
    30.04.2015 17:10:30
    Klexy
    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
    

    Anzeige
    AW: Makro für Kommentarfeld Schrift und Text Größe anp
    30.04.2015 21:28:31
    Becker
    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 
    aber leider da hebe ich zu wenig Ahnung es alleine umzuändern.
    Hoffentlich war ich diesmal mehr veständlicher.
    Veien Dank Klexy
    Daniel

    Anzeige
    AW: Makro für Kommentarfeld Schrift und Text Größe anp
    02.05.2015 11:18:02
    Klexy
    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
    

    Anzeige
    AW: Makro für Kommentarfeld Schrift und Text Größe
    04.05.2015 13:23:35
    Becker
    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

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

    AW: Makro für Kommentarfeld Schrift und Text Größe
    04.05.2015 22:41:56
    Becker
    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
    Anzeige

    Links zu Excel-Dialogen

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige