grootte van comment box

[popipipo]

http://www.helpmij.nl/forum/showthread.php/575353-kalender-met-commentaar
Naar aanleiding van deze vraag nog een klein aanvulling.
De comment box is in sommige gevallen te klein en zou dus groter moeten worden

Heb het getracht door de rode tekst toe te voegen maar dit werkt toch niet.

Sub invullen()
Dim ws As Worksheet, cmt As Comment
On Error Resume Next
For Each ws In ThisWorkbook.Sheets
        For Each cmt In ws.Comments
            cmt.Delete
        Next cmt
    Next
For Each cl In Sheets("feestdagen").Range("A2:A" & Sheets("feestdagen").Cells(Rows.Count, 1).End(xlUp).Row)
    For i = 1 To Sheets.Count - 3
      Sheets(i).Range ("B4:O39")
      Set rFoundCell = Sheets(i).UsedRange.Find(cl.Value, , xlValues, xlWhole)
        With rFoundCell
            With .AddComment
[COLOR="Red"]                Comment.Shape.Select True
                Selection.ShapeRange.SetShapesDefaultProperties
                Selection.ShapeRange.ScaleWidth 1.5, msoFalse, msoScaleFromTopLeft
                Selection.ShapeRange.ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft[/COLOR]
                    .Text cl.Offset(, 5).Value
                    .Visible = False
                
            End With
        End With
   Sheets(i).Range ("B4:O39")
    Next i
Next cl
End Sub

 

[exhelp]

Hoi Popipipo,

Probeer deze eens?

.Comment.AutoSize = True

 

[E v R]

Willem jouw rode gedeelte verwijderd en het rode gedeelte toegevoegd:

Sub invullen()
    Dim ws As Worksheet, cmt As Comment
    On Error Resume Next
    For Each ws In ThisWorkbook.Sheets
        For Each cmt In ws.Comments
            cmt.Delete
        Next cmt
    Next
    For Each cl In Sheets("feestdagen").Range("A2:A" & Sheets("feestdagen").Cells(Rows.Count, 1).End(xlUp).Row)
        For i = 1 To Sheets.Count - 3
            Sheets(i).Range ("B4:O39")
            Set rFoundCell = Sheets(i).UsedRange.Find(cl.Value, , xlValues, xlWhole)
            With rFoundCell
                With .AddComment
                    .Text cl.Offset(, 5).Value
                    .Visible = False
                End With
                [COLOR="red"]With rFoundCell.Comment.Shape
                     .SetShapesDefaultProperties
                    .ScaleWidth 1.5, msoFalse, msoScaleFromTopLeft
                    .ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
                End With[/COLOR]

            End With
            Sheets(i).Range ("B4:O39")
        Next i
    Next cl
End Sub

 

[cow18]

ik denk dat het grootste probleem dat puntje voor comment is

.AddComment
    .Comment.Visible = True
    .Comment.Shape.TextFrame.AutoSize = True
    .Comment.Shape.AutoShapeType = msoShapeRoundedRectangle

 

[popipipo]

Eric jij bent de winnaar geworden,.
Ik heb jou voorbeeld gebruikt.

Alle 3 bedankt voor de moeite.