'Resize commentbox picture size in VBa excel 2013

When I record a macro I get

Range("C1").Select 
Range("C1").AddComment 
Range("C1").Comment.Text Text:="Blabla" 
Selection.ShapeRange.ScaleHeight 2.3, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleWidth 23.1, msoFalse, msoScaleFromTopLeft

Running this code results in :

Runtime error '438': Object doesn't support this property or method

Anyone any idea?



Solution 1:[1]

You can use the Comment directly:

With Range("C1")
    .AddComment Text:="Blabla"
    With .Comment.Shape
        .ScaleHeight 2.3, msoFalse, msoScaleFromTopLeft
        .ScaleWidth 23.1, msoFalse, msoScaleFromTopLeft
    End With
End With

Solution 2:[2]

Same with Rory. I add clearcomments first before add comment to avoid an error if a comment already exist.

Sub AddCommentAndResize()

With Range("C1")
    .ClearComments
    .AddComment Text:="Blabla"
    With .Comment.Shape
        .ScaleHeight 2.3, msoFalse, msoScaleFromTopLeft
        .ScaleWidth 23.1, msoFalse, msoScaleFromTopLeft
    End With
End With

End Sub

Solution 3:[3]

I have found the following code useful when resizing comment boxes. This doesn't help resolve the original problem, but it fits better with the title of this post. You simply change the MAX_COMMENT_WIDTH to any value. I have it set to 250.

Sub AutoSizeCommentInSelectedCell()
    Dim cellComment As Comment  ' selected cell
    Dim area As Double          ' comment rectangle area
    Dim n As Integer, vS As Variant
    Dim myMax As Integer, base As Single, rowLen As Integer
    Dim Wf As WorksheetFunction
    Dim vR(), rowCnt As Integer, myHeight As Single

    Set Wf = WorksheetFunction

    Const MAX_COMMENT_WIDTH = 250

    ' Make sure we have a seected cell.
    If ActiveCell Is Nothing Then
        Exit Sub
    End If

    ' Make sure we have a comment in the selected cell.
    Set cellComment = ActiveCell.Comment

    If cellComment Is Nothing Then
        Exit Sub
    End If

    With cellComment
        'myLen = Len(.Text)

        vS = Split(.Text, Chr(10))
        ReDim vR(UBound(vS))
        For I = 0 To UBound(vS)
            vR(I) = Len(vS(I))
        Next I
        myMax = Wf.Max(vR)
        n = UBound(vS)
        ' AutoSize will covert comment to a single line.
        .Shape.TextFrame.AutoSize = True

        ' If comment's width is shorter than max, we're done.
        With .Shape
            base = .Height / (n + 1)
            rowLen = Wf.RoundDown(myMax * (MAX_COMMENT_WIDTH / .Width), 0) 'row character's length when width at max
            rowLen = rowLen - rowLen * 0.1 '<~~line character's number  is more small.
            For I = 0 To n
                If Len(vS(I)) = 0 Then
                    rowCnt = rowCnt + 1
                Else
                    rowCnt = rowCnt + Wf.RoundUp(Len(vS(I)) / rowLen, 0)
                End If
            Next I
            myHeight = rowCnt * base

            If .Width < MAX_COMMENT_WIDTH Then
                Exit Sub
            End If
            .Width = MAX_COMMENT_WIDTH
            .Height = myHeight
        End With
    End With
End Sub

Source: Link

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1 Rory
Solution 2 Paidjo
Solution 3 Jordan Kendall