Option Explicit
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim Shp As Shape
For Each Shp In Sh.Shapes
If Shp.Type = msoComment Then
Shp.TextFrame.AutoSize = True
End If
Next
End Sub
Option Explicit
Private Type TTAddInLocals
xlAppEvents As clsAppEvts
End Type
Private this As TTAddInLocals
Private Sub Workbook_AddinInstall()
Set this.xlAppEvents = New clsAppEvts
End Sub
Private Sub Workbook_AddinUninstall()
Set this.xlAppEvents = Nothing
End Sub
Option Explicit
Public WithEvents AppEvts As Excel.Application
Private Sub Class_Initialize()
Set AppEvts = Excel.Application
End Sub
Private Sub Class_Terminate()
Set AppEvts = Nothing
End Sub
Private Sub AppEvts_SheetActivate(ByVal Sh As Object)
Dim Shp As Shape
For Each Shp In Sh.Shapes
If Shp.Type = msoComment Then
Shp.TextFrame.AutoSize = True
End If
Next
End Sub
Does it matter if I'm on Excel 365? I saved in the Add-ins folder but can't see my add-in thereafter:I see. Well, there are two options to accomplish this.
To build this AddIn open / create a fresh new workbook. Go into the VBE, within Project Explorer double click upon ThisWorkbook to open its module window and paste the code below.
- The first option is to put the code from my previous post in the workbooks that qualify for that. This has the advantage that if the workbook moves to another computer, the code continues to do its job.
- The second option is to build an AddIn, which of course only works on the computer where it's installed. The latter isn't very complicated, though.
This goes in the ThisWorkbook module:
VBA Code:Option Explicit Private Type TTAddInLocals xlAppEvents As clsAppEvts End Type Private this As TTAddInLocals Private Sub Workbook_AddinInstall() Set this.xlAppEvents = New clsAppEvts End Sub Private Sub Workbook_AddinUninstall() Set this.xlAppEvents = Nothing End Sub
After that click on Menu > Insert > Class Module to insert a new class module of which window will be opened. Now open the Properties Window by pressing F4 key and rename the module's name from Class1 to clsAppEvts. Paste the code below in there.
This goes in a Class module to be renamed clsAppEvts:
VBA Code:Option Explicit Public WithEvents AppEvts As Excel.Application Private Sub Class_Initialize() Set AppEvts = Excel.Application End Sub Private Sub Class_Terminate() Set AppEvts = Nothing End Sub Private Sub AppEvts_SheetActivate(ByVal Sh As Object) Dim Shp As Shape For Each Shp In Sh.Shapes If Shp.Type = msoComment Then Shp.TextFrame.AutoSize = True End If Next End Sub
Now click on Menu > Debug > Compile VBAproject. If nothing happens you're good and you may close the VBE, since we're about to save the AddIn on disk.
Goto File tab, SaveAs and click Browse (do not navigate to any folder ...). Give your AddIn an appropriate name (so change Book1.xlsx in) say, AdjustCommentBoxes. After that click the Save As Type dropdown and choose Excel AddIn (*.xlam). The Save Dialog will automatically navigate to Excel's AddIn folder, like: C:\Users\mSolver\AppData\Roaming\Microsoft\AddIns
Do agree with Excel's proposal and save your AddIn by clicking the Save button. In Excel, make sure you have Developer tab. To accomplish this goto File tab > Options > Customize Ribbon, check the Developer tab's checkbox and click OK button. On Developer tab click AddIns to open its dialog, in wich your new AddIn should be visible.
View attachment 47791
Check its checkbox to install your AddIn and the code of your AddIn will affect all your workbooks.
.TextFrame.AutoSize = True
Option Explicit
Private Sub Workbook_Activate()
Call AutoFitAllComments(ActiveSheet)
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Call AutoFitAllComments(Sh)
End Sub
Private Sub AutoFitAllComments(ByVal Sh As Object)
Dim oComment As Comment
For Each oComment In Sh.Comments
If CommentHasChanged(oComment) Then
Call FitToTextTall(oComment, Sh)
End If
Next
End Sub
Private Function FitToTextTall(ByVal oComment As Comment, ByVal ParentSheet As Worksheet) As Boolean
Dim Width As Single, Height As Single
Dim oTempTextBox As Shape
If ParentSheet.ProtectContents Then _
Exit Function
Application.ScreenUpdating = False
On Error Resume Next
ParentSheet.Shapes("TempTextBox").Delete
Err.Clear
With oComment.Shape
Width = .Width
Height = .Height
End With
Set oTempTextBox = ParentSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, Width, Height)
oTempTextBox.Name = "TempTextBox"
With oTempTextBox.TextFrame2
.TextRange.Text = oComment.Text
.TextRange.Font.Size = oComment.Shape.TextFrame.Characters.Font.Size
.TextRange.Font.Name = oComment.Shape.TextFrame.Characters.Font.Name
.MarginRight = 0
.MarginLeft = 0
.AutoSize = msoAutoSizeShapeToFitText
End With
With oComment.Shape
.Height = oTempTextBox.Height + 10
.AlternativeText = oComment.Text & "||" & .Width & "||" & .Height
End With
oTempTextBox.Delete
If Err.Number = 0 Then _
FitToTextTall = True
End Function
Private Function CommentHasChanged(ByVal oComment As Comment) As Boolean
Dim sText As String, sWidth As String, sHeight As String
On Error Resume Next
With oComment.Shape
sText = Split(.AlternativeText, "||")(0)
sWidth = Split(.AlternativeText, "||")(1)
sHeight = Split(.AlternativeText, "||")(2)
CommentHasChanged = _
oComment.Text <> sText Or CStr(.Width) <> sWidth Or CStr(.Height) <> sHeight
End With
End Function
Doesn't it resize at all or does it stretches like for example the image attached?I also tested the original method of applying it to the workbook only - but it doesn't resize my comment boxes to fit all text..
Public Sub RunOnce()
Application.EnableEvents = True
End Sub