'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 |
