Comment box

[Xx7]

I would like to create a macro that inserts a comment to a cell that is Arial 12 and Blue Text. I would like to run the macro, an input box will pop-up, I will type the text, then the comment will show. Thx

 

[Tigs81]

Hi
This should do the job for you.

Sub AddCommentPrompt()
  Dim strComment As Comment
  Dim myText As String
  
  myText = InputBox("Enter Here Comment", "Comments Please")
  
  Set strComment = ActiveCell.Comment
  If Not (strComment Is Nothing) Then
    ActiveCell.Comment.Delete
  End If
  Set strComment = ActiveCell.AddComment
  If (myText <> "") Then
    strComment.Text Text:=myText
  End If
  With strComment.Shape.TextFrame.Characters.Font
    .Name = "Arial"
    .Size = 12
    .Bold = False
    .ColorIndex = 5
  End With
End Sub

Thanks

 

[Xx7]

Works great Tigs!! is there any way change the default width of the comment? and can the height be adjusted to the amount of rows entered... so that there is no blank white space below?

 

[Tigs81]

Xx7

I dont know of any default width options. But if you change the size of the comment box based on the area of the comment box currently, you can typically get it to fit in based on your defined width..
as shown below

    Dim intCommentWidth As Integer
    strComment.Shape.TextFrame.AutoSize = True
    With strComment
      intCommentWidth = 250
      If .Shape.Width > intCommentWidth Then
        .Shape.Height = ((.Shape.Width * .Shape.Height) / intCommentWidth) * 1.2
        .Shape.Width = intCommentWidth
        ActiveCell.Value = strComment.Shape.Height & " - " & strComment.Shape.Width
      End If
    End With

thanks
tigs

 

[Xx7]

Hmmm... if I right a long comment with that code, I will get something like this: "84.75 - 249.75" or "34.5 - 249.75" showing up in the cell

Sub CommentInsert()
  Dim strComment As Comment
  Dim myText As String
 
  
  myText = InputBox("Enter Here Comment", "Comments Please")
  
  Set strComment = ActiveCell.Comment
  If Not (strComment Is Nothing) Then
    ActiveCell.Comment.Delete
  End If
  
  Set strComment = ActiveCell.AddComment
  If (myText <> "") Then
    strComment.Text Text:=myText
  End If
  With strComment.Shape.TextFrame.Characters.Font
    .Name = "Arial"
    .Size = 10
    .Bold = False
    .ColorIndex = 5
  End With
  
 
    Dim intCommentWidth As Integer
    strComment.Shape.TextFrame.AutoSize = True
    With strComment
      intCommentWidth = 250
      If .Shape.Width > intCommentWidth Then
        .Shape.Height = ((.Shape.Width * .Shape.Height) / intCommentWidth) * 1.2
        .Shape.Width = intCommentWidth
        ActiveCell.Value = strComment.Shape.Height & " - " & strComment.Shape.Width
      End If
    End With

  
End Sub

 

[Tigs81]

sorry take out this line
i was testing it to make sure it worked.

ActiveCell.Value = strComment.Shape.Height & " - " & strComment.Shape.Width

thanks
tigs

 

[Xx7]

nice, thx!