VBA: Auto Format Comments

[itsmekarak]

Hello all,

A large part of my workday involves reviewing worksheets containing comments. Some comments are formatted perfectly whereas others need resizing. In turn I find myself doing the same activity over and over again to format them; which led me to discover this auto formatting macro:

Sub AutoFormatComments()


Dim MyComments As Comment
Dim lArea As Long


For Each MyComments In ActiveSheet.Comments
With MyComments
.Shape.TextFrame.AutoSize = True
If .Shape.Width > 150 Then
lArea = .Shape.Width * .Shape.Height
'Width of 150 gets me as close to 9.26cm as feasible
.Shape.Width = 150
.Shape.Height = (lArea / 150) * 0.75
End If
End With
Next ' comment


Dim cmt As Comment
For Each cmt In ActiveSheet.Comments
cmt.Shape.Top = cmt.Parent.Top + 5
cmt.Shape.Left = _
cmt.Parent.Offset(0, 1).Left + 5
Next ' comment

End With
Next 'comment
End Sub

This is a fantastic script in that it sets the width of the comment and then auto adjusts for the height base on the amount of text. It would be perfect if it could just include these additional features:

1. Run for only one cell instead of all cells in a worksheet
2. Change the font to the following:
   • Choose Calibri for the font
   • Choose Bold for the font style
   • Choose size 9 for the font size
   • Choose Red for the font color on the 1st line only
   • Choose Black for the font color for all remaining text
3. Set it to move but don't size with cells
4. Set it to a keyboard shortcut of Ctrl + T

Can someone assist with modifying this macro? Thank you in advance for any and all help!

Sincerely,
Kara

 

[ParamRay]

Add the following code to your existing procedure. You need to assign the keyboard shortcut yourself.

Public Sub FormatTextBox()
  ' Procedure to adjust the properties of
  ' the selected comment. Also works with
  ' other textboxes.
  
  Dim intLinefeed As Integer
  Dim intLength As Integer
  Dim TB As TextBox
  
  ' Exit if selection is not a textbox
  If Not TypeOf Selection Is TextBox Then Exit Sub
  
  ' Set font to calibri, bold, size 9
  Set TB = Selection
  TB.Font.Name = "Calibri"
  TB.Font.Bold = True
  TB.Font.Size = 9
  
  ' Get length of text and position of linefeed
  intLength = Len(TB.Text)
  intLinefeed = InStr(1, TB.Text, vbLf)
  
  ' Set first line of text to red font, remaining text to black font
  If intLinefeed > 0 Then TB.Characters(1, intLinefeed - 1).Font.Color = vbRed
  TB.Characters(intLinefeed + 1, intLength - intLinefeed).Font.Color = vbBlack
  
  ' Set placement to move but don't size
  TB.Placement = xlMove
  
  Set TB = Nothing
End Sub

 

[ParamRay]

Forgot to mention that you can set the height, width, top and left of the textbox in the same way you did before, by using TB.Height = ..., TB.Width = ..., etc. You can also set the AutoSize property by using TB.AutoSize = True. So you can incorporate everything you had before into this macro.

 

[itsmekarak]

Thank you for your help. Unfortunately, the font did not change to Calibri and the first line isn't a red color. Also, when I view the properties of the comment it doesn't show that it's been changed from the default to move but don't size. I must have done something wrong when combining the scripts. Here it is in its entirety for your review. Thank you again for your help. It's greatly appreciated!

Sub Fixed_Width_Format_Comments()

Dim MyComments As Comment
Dim lArea As Long


For Each MyComments In ActiveSheet.Comments
With MyComments
.Shape.TextFrame.AutoSize = True
If .Shape.Width > 150 Then
lArea = .Shape.Width * .Shape.Height
'Width of 150 gets me as close to 9.26cm as feasible
.Shape.Width = 150
.Shape.Height = (lArea / 150) * 0.75
End If
End With
Next ' comment


Dim cmt As Comment
For Each cmt In ActiveSheet.Comments
cmt.Shape.Top = cmt.Parent.Top + 5
cmt.Shape.Left = _
cmt.Parent.Offset(0, 1).Left + 5
Next ' comment

Dim intLinefeed As Integer
Dim intLength As Integer
Dim TB As TextBox

' Exit if selection is not a textbox
If Not TypeOf Selection Is TextBox Then Exit Sub

' Set font to calibri, bold, size 9
Set TB = Selection
TB.Font.Name = "Calibri"
TB.Font.Bold = True
TB.Font.Size = 9

' Get length of text and position of linefeed
intLength = Len(TB.Text)
intLinefeed = InStr(1, TB.Text, vbLf)

' Set first line of text to red font, remaining text to black font
If intLinefeed > 0 Then TB.Characters(1, intLinefeed - 1).Font.Color = vbRed
TB.Characters(intLinefeed + 1, intLength - intLinefeed).Font.Color = vbBlack

' Set placement to move but don't size
TB.Placement = xlMove

Set TB = Nothing


End Sub

 

[ParamRay]

Perhaps I didn't explain it very well! Replace everything with the following code instead.


Note that you need to select the comment before running the macro otherwise nothing will happen. In other words, don't just position the cursor inside the comment - actually SELECT the comment so that you can see the resizing handles on the corners and sides.

Public Sub FormatTextBox()
  ' Procedure to adjust the properties of
  ' the selected comment.
  
  Dim intLinefeed As Integer
  Dim intLength As Integer
  Dim TB As TextBox
  
  ' Exit if selection is not a textbox
  If Not TypeOf Selection Is TextBox Then Exit Sub
  
  ' Set font to calibri, bold, size 9
  Set TB = Selection
  TB.Font.Name = "Calibri"
  TB.Font.Bold = True
  TB.Font.Size = 9
  
  ' *** ADDED THIS SECTION *************************
  
    ' Automatically size to text
    TB.AutoSize = True
    
    ' Set to custom size
    If TB.Width > 150 Then
      TB.Width = 150
      TB.Height = 0.75 * (TB.Width * TB.Height) / 150
    End If
    
    ' Move to custom position
    Dim cmt As Comment
    For Each cmt In TB.Parent.Comments
      If cmt.Shape.Name = TB.Name Then
        TB.Top = cmt.Parent.Top + 5
        TB.Left = cmt.Parent.Offset(, 1).Left + 5
        Exit For
      End If
    Next cmt
    Set cmt = Nothing


  ' ************************************************
  
  ' Get length of text and position of linefeed
  intLength = Len(TB.Text)
  intLinefeed = InStr(1, TB.Text, vbLf)
  
  ' Set first line of text to red font, remaining text to black font
  If intLinefeed > 0 Then TB.Characters(1, intLinefeed - 1).Font.Color = vbRed
  TB.Characters(intLinefeed + 1, intLength - intLinefeed).Font.Color = vbBlack
  
  ' Set placement to move but don't size
  TB.Placement = xlMove
  
  Set TB = Nothing
End Sub

 

[itsmekarak]

Thank you for your help and patience. I replaced my script entirely with the script you provided and get a message "Run-time error '16': Expression too complex." When I click on the Debug option, I'm taken to this portion of the script...
TB.Height = 0.75 * (TB.Width * TB.Height) / 150. Any idea how I could repair this?

Thank you for your continued assistance.

 

[ParamRay]

I think it's a glitch.

Try changing it to:

TB.Height = CSng((TB.Width * TB.Height) / 200)

 

[itsmekarak]

Hello,

Thank you so much for your continued help. The run-time error went away, but now it doesn't auto adjust. So I have a long comment,but it's only showing about a 200x300 pixel size box. The 200 pixels is perfect, but the 300 is limiting. Is there anything additional that an be done to repair this?