Excel Comment Macros
Add any of the following macros to a workbook that opens automatically
when Excel opens (e.g. Personal.xls), then add a toolbar button or shortcut
key to run it. Also see more comment macros
NOTE: These macros are for the old-style Excel comments, now called Notes in newer versions of Excel. For Threaded comments, see the macros on the Threaded Comment Macro page
Author: Debra Dalgleish
Insert - Plain Comment
Replace Old Name in Comments - No Pictures
Replace Old Name in Comments - With Pictures
Change the User Name
Instead of showing the user name at the start of Excel comments, you can change to something generic, such as "Note:" However, this change affects the User Name in all Microsoft Office programs, so you may want to reset the name before you exit Excel.
To set a generic label in comments:
Sub CommentNote()
Application.UserName = "Note"
End Sub
To reset the User Name in comments:
Sub CommentName()
Application.UserName = "John Smith"
End Sub
Insert a Plain Comment
To insert a comment with no User Name, use the following macro.
Note: Because the macro contains a SendKeys
command, it should be run with the worksheet active, not Visual
Basic Explorer. Go to Top
Sub CommentAddOrEdit()
'adds new plain text comment or positions
'cursor at end of existing comment text
'www.contextures.com/xlcomments03.html
Dim cmt As Comment
Set cmt = ActiveCell.Comment
If cmt Is Nothing Then
ActiveCell.AddComment text:=""
End If
SendKeys "+{F2}"
End Sub
To avoid use of the SendKeys command, you can use the following variation, which leaves the comments visible. After running the macro, the comment shape is selected. Start typing, and the text will be added to the comment box, or to the end of the existing comment text. Go to Top
Sub CommentAddOrEdit() 'method suggested by Jon Peltier 2006-03-04 'adds new plain text comment or adds text 'at end of existing comment text Dim cmt As Comment Set cmt = ActiveCell.Comment If cmt Is Nothing Then Set cmt = ActiveCell.AddComment cmt.text text:="" End If 'type to add comment text to selected shape cmt.Visible = True cmt.Shape.Select End Sub
Replace Old Name in Comments - No Pictures
If a previous user inserted comments, their name may appear at the top of the comment. Their name may also appear in the Status Bar, when you hover over the cell that contains a comment.
The following macro will replace the old name with a new name.
NOTE: This creates new comments, without the original formatting. If you need to copy comment pictures, or other formatting, use the macro in the next section - Replace Names With Pictures
Sub ChangeCommentName()
'replaces old names in comments
'deletes and reinserts comments
' so new name appears in status bar
'www.contextures.com/xlcomments03.html
Dim ws As Worksheet
Dim cmt As Comment
Dim strOld As String
Dim strNew As String
Dim strComment As String
strNew = "New Name"
strOld = "Old Name"
Application.UserName = strNew
For Each ws In ActiveWorkbook.Worksheets
For Each cmt In ws.Comments
strComment = Replace(cmt.text, strOld, strNew)
cmt.Delete
cmt.Parent.AddComment text:=strComment
Next cmt
Next ws
End Sub
Replace Old Name in Comments - With Pictures
This macro is similar to the one above -- it replaces the old names attached to cell comments. However, this macro also copies the old comment formatting. Use this if you want to copy pictures, or other formatting, from the original comments.
This macro will be a bit slower, so use the Replace Name No Pictures macro if you're not concerned about formatting. It adds a temporary worksheet, pastes the old comment there, and copies the formatting to the new comment. Go to Top
Sub ChangeCommentNameKeepPicture()
'replaces old names in comments
'deletes and reinserts comments
' so new name appears in status bar
'also copies pictures and other formatting
'www.contextures.com/xlcomments03.html
Dim ws As Worksheet
Dim wsTemp As Worksheet
Dim rngTempOld As Range
Dim rngTempNew As Range
Dim cmt As Comment
Dim strOld As String
Dim strNew As String
Dim strComment As String
strNew = "New Name"
strOld = "Old Name"
Application.UserName = strNew
Dim strCmtText As String
Dim cmtOld As Comment
Dim cmtNew As Comment
Dim lCmtShow As Long
On Error Resume Next
Application.DisplayAlerts = False
lCmtShow = Application.DisplayCommentIndicator
'show the comments
Application.DisplayCommentIndicator = xlCommentAndIndicator
Application.ScreenUpdating = False
Set ws = ActiveSheet
Set wsTemp = Sheets.Add
Set rngTempOld = wsTemp.Range("A1")
Set rngTempNew = wsTemp.Range("A2")
For Each cmtOld In ws.Comments
strCmtText = Replace(cmtOld.Text, strOld, strNew)
cmtOld.Parent.Copy
rngTempOld.PasteSpecial xlPasteComments
Set cmtNew = rngTempNew.AddComment
cmtNew.Text Text:=strCmtText
rngTempOld.Comment.Visible = True
rngTempNew.Comment.Visible = True
rngTempOld.Comment.Shape.Select
Selection.ShapeRange.PickUp
rngTempNew.Comment.Shape.Select
Selection.ShapeRange.Apply
cmtOld.Delete
rngTempNew.Copy
cmtOld.Parent.PasteSpecial Paste:=xlPasteComments
rngTempOld.Clear
rngTempNew.Clear
Next cmtOld
ws.Activate
wsTemp.Delete
Application.UserName = strOld
Application.DisplayCommentIndicator = lCmtShow
Application.ScreenUpdating = True
End Sub
Insert a Formatted Comment
To insert comments with no User Name, formatted in Times New Roman font, use the following macro, which uses the SendKeys method:
Sub CommentAddOrEditTNR()
'adds TimesNewRoman comment or positions
'cursor at end of existing comment text
'www.contextures.com/xlcomments03.html
Dim cmt As Comment
Set cmt = ActiveCell.Comment
If cmt Is Nothing Then
ActiveCell.AddComment text:=""
Set cmt = ActiveCell.Comment
With cmt.Shape.TextFrame.Characters.Font
.Name = "Times New Roman"
.Size = 11
.Bold = False
.ColorIndex = 0
End With
End If
SendKeys "+{F2}"
End Sub
Insert a Colour Formatted Comment
To insert a comment with no User Name, formatted with red text in the first line, blue text in the second line, and bold text after the colons, use the following macro:
Sub CommentTextFormatColour()
'adds comment then formats font colour and adds bold
'www.contextures.com/xlcomments03.html
Dim cmt As Comment
Dim str1 As String
Dim str2 As String
Dim lBreak As Long
Dim lNum1 As Long
Dim lNum2 As Long
Dim lNumLen As Long
Dim strFind As String
On Error Resume Next
str1 = "John: 20 Eggs"
str2 = "Simon: 50 Eggs"
strFind = ":"
lNumLen = 3
Set cmt = ActiveCell.Comment
If cmt Is Nothing Then
ActiveCell.AddComment _
text:=str1 & Chr(10) & str2
Set cmt = ActiveCell.Comment
End If
'find the line break and markers
lBreak = InStr(1, cmt.text, Chr(10))
lNum1 = InStr(1, cmt.text, strFind) + 1
lNum2 = InStr(lBreak, cmt.text, strFind) + 1
'format the lines of text
With cmt.Shape.TextFrame
.Characters(1, lBreak).Font.ColorIndex = 3
.Characters(lBreak + 1, _
Len(cmt.text)).Font.ColorIndex = 5
End With
'add bold to numbers that follow colon
If lNum1 > 0 Then
With cmt.Shape.TextFrame
.Characters.Font.Bold = False
.Characters(lNum1, lNumLen).Font.Bold = True
.Characters(lNum2, lNumLen).Font.Bold = True
End With
End If
SendKeys "+{F2}" 'opens comment for editing
'SendKeys "%ie~" 'works with Excel 2003 menu
End Sub
Insert comments with Date and Time
To insert comments with the current date and time, or append the current date and time to an existing comment, use the following macro. It uses the SendKeys method:
Sub CommentDateTimeAdd()
'adds comments with date and time,
' positions cursor at end of comment text
'www.contextures.com/xlcomments03.html
Dim strDate As String
Dim cmt As Comment
strDate = "dd-mmm-yy hh:mm:ss"
Set cmt = ActiveCell.Comment
If cmt Is Nothing Then
Set cmt = ActiveCell.AddComment
cmt.text _
text:=Format(Now, strDate) & Chr(10)
Else
cmt.text text:=cmt.text & Chr(10) _
& Format(Now, strDate) & Chr(10)
End If
With cmt.Shape.TextFrame
.Characters.Font.Bold = False
End With
'opens comment for editing
SendKeys "+{F2}"
End Sub
Reset Comments to Original Position
If comments have moved out of position, you can reset them using the following code:
Sub ResetComments()
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
End Sub
Resize comments
If comments have changed size, you can reset them using the following code. The methods are not perfect, but are useful for cleaning up many comments that have changed size.
---Macro 1 resizes all comments on the active sheet, based on the area of the AutoSized comment
---Macro 2 resizes all comments in the selected range, based on the area of the AutoSized comment
---Macro 3 resizes all comments in the selected range, based on the row height of a test cell
---How the AutoSize macros work
1 - Resize all comments on the active sheet (based on AutoSize area)
Sub Comments_AutoSize()
Dim MyComments As Comment
Dim lArea As Long
Dim lMult As Double
Dim MaxW As Long
Dim NewW As Long
'Height adjustment factor
'of 1.1 seems to work ok.
lMult = 1.1
MaxW = 300
NewW = 200
For Each MyComments In ActiveSheet.Comments
With MyComments
.Shape.TextFrame.AutoSize = True
If .Shape.Width > MaxW Then
lArea = .Shape.Width * .Shape.Height
.Shape.Width = NewW
.Shape.Height = (lArea / NewW) * lMult
End If
End With
Next ' comment
End Sub
2 - Resize all comments in the selected area
(based on AutoSize area)
Sub ResizeCommentsInSelection()
'Posted by Dave Peterson 2002-02-25
Dim mycell As Range
Dim myRng As Range
Dim lArea As Long
Dim lMult As Double
Dim MaxW As Long
Dim NewW As Long
'Height adjustment factor
lMult = 1.2
MaxW = 300
NewW = 200
Set myRng = Selection
For Each mycell In myRng.Cells
If Not (mycell.Comment Is Nothing) Then
With mycell.Comment
.Shape.TextFrame.AutoSize = True
If .Shape.Width > MaxW Then
lArea = .Shape.Width * .Shape.Height
.Shape.Width = NewW
.Shape.Height _
= (lArea / NewW) * lMult
End If
End With
End If
Next mycell
End Sub
3 - Resize all comments in the selected area
(based on test cell height)
Sub ResizeCommentsInSelectionRH()
'www.contextures.com
'resize comments based on row height
'of test cells where text was copied
Dim lMinWidth As Long
Dim lMaxWidth As Long
Dim lWidth As Long
Dim dblMult As Double
Dim dblMultH As Double
Dim mycell As Range
Dim myRng As Range
Dim strText As String
Dim dColW As Double
Dim dColCW As Double
Dim lHeight As Long
Dim lChar As Long
Dim lCount As Long
Dim lBreak As Long
Dim sh As Shape
Dim strAdd As String
Dim wsTemp As Worksheet
Dim dMaxWPt As Double
'.columnwidth/.width
Dim dRatio As Double
'.columnwidth for test
Dim dCWTest As Double
On Error Resume Next
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'On Error Resume Next
Select Case CDbl(Application.Version)
Case Is > 14
strAdd = " "
Case Else
strAdd = ""
End Select
Set myRng = Intersect(Selection, _
ActiveSheet.UsedRange)
Set wsTemp = Worksheets.Add
If Not wsTemp Is Nothing Then
lMinWidth = _
InputBox("Which comments should be resized?" _
& vbCrLf & "Width greater than:", _
"Resize Sheet Comments", 1)
If lMinWidth = 0 Then
MsgBox "Width must be 1 or greater"
Exit Sub
End If
lMaxWidth = InputBox("What should be the new comment width?", _
"Resize Sheet Comments", 300)
If lMaxWidth = 0 Then
MsgBox "Width must be 1 or greater"
Exit Sub
End If
dblMultH = _
InputBox("What multiplier should be used for Height?", _
"Resize Sheet Comments", 1#)
If dblMultH = 0 Then
Exit Sub
End If
'.Width property uses points
' 96 pixels to 72 points
dblMult = 72 / 96
'desired comment width in points
dMaxWPt = lMaxWidth * dblMult
'.ColumnWidth property shows
'number of characters
'One unit of column width =
'width of one character in Normal style
'For proportional fonts, the width of
' the character 0 (zero) is used.
dCWTest = 100 '.columnwidth for test
With wsTemp.Columns(1)
.ColumnWidth = dCWTest
'get ratio of .columnwidth (char)
' to .width property (points)
dRatio = .Width / dCWTest
'multiply desired width by test ratio
' for .ColumnWidth setting
.ColumnWidth = dMaxWPt / dRatio
End With
For Each mycell In myRng.Cells
If Not (mycell.Comment Is Nothing) Then
Set sh = mycell.Comment.Shape
If sh.Width > lMinWidth Then
lChar = sh.TextFrame.Characters.Count
With wsTemp
.Range("A1:A3").ClearContents
If lChar <= 255 Then
.Range("A1").Value _
= sh.TextFrame.Characters.Text
Else
For lCount = 1 To lChar Step 250
Select Case lCount
Case Is <= 250 * 3
.Range("A1").Value = .Range("A1").Value _
& sh.TextFrame.Characters(Start:=lCount, _
Length:=250).Text & strAdd
Case Is <= 250 * 6
.Range("A2").Value = .Range("A2").Value _
& sh.TextFrame.Characters(Start:=lCount, _
Length:=250).Text & strAdd
Case Else
.Range("A3").Value = .Range("A3").Value _
& sh.TextFrame.Characters(Start:=lCount, _
Length:=250).Text & strAdd
End Select
Next lCount
End If
.Range("A1:A3").Font.Name = _
sh.TextFrame.Characters.Font.Name
.Range("A1:A3").Font.Size = _
sh.TextFrame.Characters.Font.Size
.Range("A1:A3").WrapText = True
.Rows("1:3").AutoFit
Select Case lChar
Case Is <= 250 * 3
lHeight = .Rows(1).Height
Case Is <= 250 * 6
lHeight = .Rows("1:2").Height
Case Else
lHeight = .Rows("1:3").Height
End Select
End With
With sh
.Height = lHeight * dblMult * dblMultH
.Width = lMaxWidth
End With
End If
End If
Next mycell
wsTemp.Delete
Else
MsgBox "Could not add temporary sheet." _
& vbCrLf _
& "Please unprotect workbook structure" _
& vbCrLf _
& " and try again."
End If
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
How the AutoSize Macros Work
The two AutoSize macros work the same way, except Macro 1 changes all comments on the worksheet, and Macro 2 only changes comments in the selected range of cells.
Variable Settings
At the top of the code there is a list of variables, and below that there are settings for 3 of those variables.
You can change the numbers for those settings, if needed, after you test the macros in your workbook. For example, if there is too much blank space at the bottom of the comment, make the multiplier (lMult) a smaller number.
lMult = 1.2 MaxW = 300 NewW = 200
AutoSize Property
For each comment, the macro starts by setting its text frame property to AutoSize.
.Shape.TextFrame.AutoSize = True
Here is a comment from the sample workbook, before the AutoSize property was changed
After the AutoSize property was changed, the comment stretched across the worksheet, to fit the longest sentence in the comment.
Check for Maximum Width
Next, the macro checks the width of the AutoSized comment, to see if it is larger than the MaxW setting.
If .Shape.Width > MaxW Then
In the sample file, the AutoSized comment's width is well over that 300 limit!
NOTE: I'm showing the numbers in these screen shots, instead of the variable names
Calculate the Area
Next, the macro calculates the area of the AutoSized comment, by multiplying its current width and height.
lArea = .Shape.Width * .Shape.Height
For the comment in the sample workbook, the height is 182.25, and the width is 1085.25.
The area for the comment is 197787 -- (1085.25 x 182.25)
Change the Width
Next, the macro changes the width of the AutoSized comment, using the value for the NewW variable
.Shape.Width = NewW
Here is the comment in the sample workbook, with its width changed to 200. Some of the comment text is not visible, because the height still needs to be adjusted.
Change the Height
Finally, the macro calculates a new height for the AutoSized comment. It divides the calculated area by the new width, and multiplies that by the multiplier variable
.Shape.Height = (lArea / NewW) * lMult
Here is the sample file comment, after the height change. All the text is visible now.
Format All comments
After you have inserted comments in a workbook, you can use the following code to change the font and font size for all comments in the workbook. Go to Top
Sub FormatAllComments()
'www.contextures.com/xlcomments03.html
Dim ws As Worksheet
Dim cmt As Comment
For Each ws In ActiveWorkbook.Worksheets
For Each cmt In ws.Comments
With cmt.Shape.TextFrame.Characters.Font
.Name = "Times New Roman"
.Size = 12
End With
Next cmt
Next ws
End Sub
All Comments - Move/Size Properties
Use these 3 macros to review or change the Object Positoning property for all comments on the active sheet.
List Comments and Current Setting
This macro lists each comment on the active sheet, with its address and its current setting for the Object Positoning property
1=Move and Size, 2=Move but don't size, 3=Don't move or size
Sub AllCommentsListProperties()
'www.contextures.com
' /xlcomments03.html
Dim ws As Worksheet
Dim cmt As Comment
'1=move/size, 2=move only
' 3-don't more or size
Set ws = ActiveSheet
For Each cmt In ws.Comments
Debug.Print cmt.Parent.Address _
& ": " & cmt.Shape.Placement
Next cmt
End Sub
All Comments - Move and Size
This macro changes the Object Positoning property for each comment on the active sheet, to Move and Size
Sub AllCommentsMoveAndSize()
'www.contextures.com
' /xlcomments03.html
Dim ws As Worksheet
Dim cmt As Comment
Set ws = ActiveSheet
For Each cmt In ws.Comments
cmt.Shape.Placement _
= xlMoveAndSize
Next cmt
End Sub
All Comments - Move but Don't Size
This macro changes the Object Positoning property for each comment on the active sheet, to Move but don't size
Sub 'www.contextures.com
' /xlcomments03.html
Dim ws As Worksheet
Dim cmt As Comment
Set ws = ActiveSheet
For Each cmt In ws.Comments
cmt.Shape.Placement _
= xlMove
Next cmt
End Sub
Show Comments on Active Sheet
If you choose View|Comments, all comments in all open workbooks will be displayed. Instead, you can use code to show the comments on one sheet, and display the comment indicators only on other sheets. Go to Top
Sub ShowSheetComments() 'www.contextures.com/xlcomments03.html 'shows all comments on the active sheet Dim c As Comment For Each c In ActiveSheet.Comments c.Visible = True Next End Sub
Show comments in Centre of Active Window
Paste the following code onto a worksheet module. If a cell with a comment is selected on that sheet, its comment is displayed in the centre of the active window's visible range.
NOTE: You must select the cell with the comment -- the code doesn't work it you just point to the cell.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'www.contextures.com/xlcomments03.html
Dim rng As Range
Dim cTop As Long
Dim cWidth As Long
Dim cmt As Comment
Dim sh As Shape
Application.DisplayCommentIndicator _
= xlCommentIndicatorOnly
Set rng = ActiveWindow.VisibleRange
cTop = rng.Top + rng.Height / 2
cWidth = rng.Left + rng.Width / 2
If ActiveCell.Comment Is Nothing Then
'do nothing
Else
Set cmt = ActiveCell.Comment
Set sh = cmt.Shape
sh.Top = cTop - sh.Height / 2
sh.Left = cWidth - sh.Width / 2
cmt.Visible = True
End If
End Sub
Show comments at Right of Active Window
Paste the following code onto a worksheet module. If a cell with a comment is selected on that sheet, its comment is displayed at the far right of the active window's visible range. A bit of space is added (lGap) to allow for scroll bar on the right side. Go to Top
Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'www.contextures.com/xlcomments03.html
'show comments at centre right of window Dim rng As Range Dim cTop As Long Dim lGap As Long Dim cmt As Comment Dim sh As Shape Application.DisplayCommentIndicator _ = xlCommentIndicatorOnly Set rng = ActiveWindow.VisibleRange cTop = rng.Top + rng.Height / 2 lGap = 30 'adjust space between window edge and comment If ActiveCell.Comment Is Nothing Then 'do nothing Else Set cmt = ActiveCell.Comment Set sh = cmt.Shape sh.Top = cTop - sh.Height / 2 sh.Left = rng.Width - sh.Width - lGap cmt.Visible = True End If End Sub
Copy Comment Text to Adjacent Cell
The following macro will copy comment text to the cell to the right, if that cell is empty. Go to Top
Sub ShowCommentsNextCell()
'based on code posted by Dave Peterson 2003-05-16
Application.ScreenUpdating = False
Dim commrange As Range
Dim mycell As Range
Dim curwks As Worksheet
Set curwks = ActiveSheet
On Error Resume Next
Set commrange = curwks.Cells _
.SpecialCells(xlCellTypeComments)
On Error GoTo 0
If commrange Is Nothing Then
MsgBox "no comments found"
Exit Sub
End If
For Each mycell In commrange
If mycell.Offset(0, 1).Value = "" Then
mycell.Offset(0, 1).Value = mycell.Comment.Text
End If
Next mycell
Application.ScreenUpdating = True
End Sub
Copy Comments to Another Worksheet
The following macro will add a sheet to the workbook, with a list of comments, including the cell address, and cell name, if any. Go to Top
Sub showcomments()
'posted by Dave Peterson 2003-05-16
Application.ScreenUpdating = False
Dim commrange As Range
Dim mycell As Range
Dim curwks As Worksheet
Dim newwks As Worksheet
Dim i As Long
Set curwks = ActiveSheet
On Error Resume Next
Set commrange = curwks.Cells _
.SpecialCells(xlCellTypeComments)
On Error GoTo 0
If commrange Is Nothing Then
MsgBox "no comments found"
Exit Sub
End If
Set newwks = Worksheets.Add
newwks.Range("A1:D1").Value = _
Array("Address", "Name", "Value", "Comment")
i = 1
For Each mycell In commrange
With newwks
i = i + 1
On Error Resume Next
.Cells(i, 1).Value = mycell.Address
.Cells(i, 2).Value = mycell.Name.Name
.Cells(i, 3).Value = mycell.Value
.Cells(i, 4).Value = mycell.Comment.Text
End With
Next mycell
Application.ScreenUpdating = True
End Sub
Copy Comments from All Sheets to Another Worksheet
The following macro will add a sheet to the workbook, with a list of comments from all sheets in the workbook, including the sheet name, cell address, and cell name, if any.
Sub ShowCommentsAllSheets()
'modified from code
'posted by Dave Peterson 2003-05-16
Application.ScreenUpdating = False
Dim commrange As Range
Dim mycell As Range
Dim ws As Worksheet
Dim newwks As Worksheet
Dim i As Long
Set newwks = Worksheets.Add
newwks.Range("A1:E1").Value = _
Array("Sheet", "Address", "Name", "Value", "Comment")
For Each ws In ActiveWorkbook.Worksheets
On Error Resume Next
Set commrange = ws.Cells.SpecialCells(xlCellTypeComments)
On Error GoTo 0
If commrange Is Nothing Then
'do nothing
Else
i = newwks.Cells(Rows.Count, 1).End(xlUp).Row
For Each mycell In commrange
With newwks
i = i + 1
On Error Resume Next
.Cells(i, 1).Value = ws.Name
.Cells(i, 2).Value = mycell.Address
.Cells(i, 3).Value = mycell.Name.Name
.Cells(i, 4).Value = mycell.Value
.Cells(i, 5).Value = mycell.Comment.text
End With
Next mycell
End If
Set commrange = Nothing
Next ws
'format cells for no wrapping, remove line break
newwks.Cells.WrapText = False
newwks.Columns("E:E").Replace What:=Chr(10), _
Replacement:=" ", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Application.ScreenUpdating = True
End Sub
Copy comments to Microsoft Word
The following code copies the comment text from the active sheet, and adds it to a Microsoft Word document, along with the cell address. Go to Top
Sub CopyCommentsToWord()
'www.contextures.com/xlcomments03.html
Dim cmt As Comment
Dim WdApp As Object
On Error Resume Next
Set WdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Err.Clear
Set WdApp = CreateObject("Word.Application")
End If
With WdApp
.Visible = True
.Documents.Add DocumentType:=0
For Each cmt In ActiveSheet.Comments
.Selection.TypeText cmt.Parent.Address _
& vbTab & cmt.Text
.Selection.TypeParagraph
Next
End With
Set WdApp = Nothing
End Sub
Print Worksheet with Comment Indicators
When you print a worksheet that contains comments, the comment indicators are not visible. There is no option to change this behaviour. As a workaround, you can draw triangle AutoShapes over the comment indicators.
Draw Triangular AutoShapes over the Comment Indicators
The following code will draw a triangular AutoShape over each comment indicator on the active sheet:
Sub CoverCommentIndicator()
'www.contextures.com/xlcomments03.html
Dim ws As Worksheet
Dim cmt As Comment
Dim rngCmt As Range
Dim shpCmt As Shape
Dim shpW As Double 'shape width
Dim shpH As Double 'shape height
Set ws = ActiveSheet
shpW = 6
shpH = 4
For Each cmt In ws.Comments
Set rngCmt = cmt.Parent
With rngCmt
Set shpCmt = ws.Shapes.AddShape(msoShapeRightTriangle, _
rngCmt.Offset(0, 1).Left - shpW, .Top, shpW, shpH)
End With
With shpCmt
.Flip msoFlipVertical
.Flip msoFlipHorizontal
.Fill.ForeColor.SchemeColor = 10 'Red
'12=Blue, 57=Green
.Fill.Visible = msoTrue
.Fill.Solid
.Line.Visible = msoFalse
End With
Next cmt
End Sub
Remove Triangular AutoShapes over the Comment Indicators
The following code will remove the triangular AutoShape over each
comment indicator on the active sheet:
Sub RemoveIndicatorShapes()
'www.contextures.com/xlcomments03.html
Dim ws As Worksheet
Dim shp As Shape
Set ws = ActiveSheet
For Each shp In ws.Shapes
If Not shp.TopLeftCell.Comment Is Nothing Then
If shp.AutoShapeType = _
msoShapeRightTriangle Then
shp.Delete
End If
End If
Next shp
End Sub
Number and List comments
Before you print a worksheet that contains comments, you can use programming to number the comments, and then list the numbered comments on a separate sheet, and print them.
After you print the sheet, run another macro to remove the numbered shapes that were added to each comment cell. Go to Top
Running the Numbered Comments Code
There are 3 parts to the code:
- Draw the numbered rectangles
- Remove the numbered rectangles:
- List the numbered comments:
- For sheets without merged cell comments
- For sheets with merged cell comments
To use the code, copy the code samples below, and paste them into a regular module in your workbook. OR, download the sample workbook, and copy the code from there.
Draw Numbered Rectangles over Comment Indicators
The following code draws a numbered rectangle AutoShape over each comment indicator on the active sheet:
Sub CoverCommentIndicator()
'www.contextures.com/xlcomments03.html
Dim ws As Worksheet
Dim cmt As Comment
Dim lCmt As Long
Dim rngCmt As Range
Dim shpCmt As Shape
Dim shpW As Double 'shape width
Dim shpH As Double 'shape height
Set ws = ActiveSheet
shpW = 8
shpH = 6
lCmt = 1
For Each cmt In ws.Comments
Set rngCmt = cmt.Parent
With rngCmt
Set shpCmt = ws.Shapes.AddShape(msoShapeRectangle, _
rngCmt.Offset(0, 1).Left - shpW, .Top, shpW, shpH)
End With
With shpCmt
.Name = "CmtNum" & .Name
With .Fill
.ForeColor.SchemeColor = 9 'white
.Visible = msoTrue
.Solid
End With
With .Line
.Visible = msoTrue
.ForeColor.SchemeColor = 64 'automatic
.Weight = 0.25
End With
With .TextFrame
.Characters.Text = lCmt
.Characters.Font.Size = 5
.Characters.Font.ColorIndex = xlAutomatic
.MarginLeft = 0#
.MarginRight = 0#
.MarginTop = 0#
.MarginBottom = 0#
.HorizontalAlignment = xlCenter
End With
.Top = .Top + 0.001
End With
lCmt = lCmt + 1
Next cmt
End Sub
Remove Numbered Rectangles over Comment Indicators
The following code will remove the rectangular AutoShape over each comment indicator on the active sheet. Run this code when you no longer need the numbered shapes:
Sub RemoveIndicatorShapes()
'www.contextures.com/xlcomments03.html
Dim ws As Worksheet
Dim shp As Shape
Set ws = ActiveSheet
For Each shp In ws.Shapes
If Not shp.TopLeftCell.Comment Is Nothing Then
If Left(shp.Name, 6) = "CmtNum" Then
shp.Delete
End If
End If
Next shp
End Sub
List Comments on New Sheet
The following code will list the numbered comments on a new worksheet. If there are merged cells with comments, use the code in the next section instead of this code.
Sub showcomments()
'posted by Dave Peterson 2003-05-16
Application.ScreenUpdating = False
Dim commrange As Range
Dim cmt As Comment
Dim curwks As Worksheet
Dim newwks As Worksheet
Dim i As Long
Set curwks = ActiveSheet
On Error Resume Next
Set commrange = curwks.Cells _
.SpecialCells(xlCellTypeComments)
On Error GoTo 0
If commrange Is Nothing Then
MsgBox "no comments found"
Exit Sub
End If
Set newwks = Worksheets.Add
newwks.Range("A1:E1").Value = _
Array("Number", "Name", "Value", "Address", "Comment")
i = 1
For Each cmt In curwks.Comments
With newwks
i = i + 1
On Error Resume Next
.Cells(i, 1).Value = i - 1
.Cells(i, 2).Value = cmt.Parent.Name.Name
.Cells(i, 3).Value = cmt.Parent.Value
.Cells(i, 4).Value = cmt.Parent.Address
.Cells(i, 5).Value = Replace(cmt.Text, Chr(10), " ")
End With
Next cmt
newwks.Cells.WrapText = False
newwks.Columns.AutoFit
Application.ScreenUpdating = True
End Sub
List Comments - Merged Cells
The following code will create a numbered list comments on a new worksheet. To add numbers in the cells, use the CoverCommentIndicator code in the previous section.
Sub showcomments_formerged()
'based on code by Dave Peterson 2003-05-16
Application.ScreenUpdating = False
Dim commrange As Range
Dim mycell As Range
Dim curwks As Worksheet
Dim newwks As Worksheet
Dim i As Long
Dim rowTop As Long
Dim colFirst As Long
Dim colLast As Long
Dim bMerge As Boolean
Set curwks = ActiveSheet
On Error Resume Next
Set commrange = curwks.Cells _
.SpecialCells(xlCellTypeComments)
On Error GoTo 0
If commrange Is Nothing Then
MsgBox "no comments found"
Exit Sub
End If
Set newwks = Worksheets.Add
newwks.Range("A1:E1").Value = _
Array("Number", "Name", "Value", "Address", "Comment")
i = 1
For Each mycell In commrange
If mycell.MergeCells Then
bMerge = True
colFirst = mycell.MergeArea.Columns(1).Column
colLast = mycell.MergeArea.Columns(mycell.MergeArea.Columns.Count).Column
rowTop = mycell.MergeArea.Rows(1).Row
Else
colFirst = mycell.Column
colLast = mycell.Column
rowTop = mycell.Row
End If
If mycell.Row = rowTop _
And mycell.Column = colLast Then
With newwks
i = i + 1
On Error Resume Next
.Cells(i, 1).Value = i - 1
.Cells(i, 2).Value = mycell.Name.Name
.Cells(i, 3).Value = _
curwks.Cells(rowTop, colFirst).Value
curwks.Cells(rowTop, colFirst).Copy
.Cells(i, 3).PasteSpecial _
Paste:=xlPasteValuesAndNumberFormats
.Cells(i, 4).Value = mycell.Address
.Cells(i, 5).Value = Replace(curwks.Cells(rowTop, _
colFirst).Comment.Text, Chr(10), " ")
End With
End If
Next mycell
newwks.Cells.WrapText = False
newwks.Columns.AutoFit
Application.ScreenUpdating = True
End Sub
Comments with Pictures From File List
You can manually insert a picture into an Excel comment, and this video shows the steps. To quickly create multiple comments with pictures, use the macro shown below.
NOTE: Pictures are not available with Threaded Comments.
The following code creates a comment with picture inserted, in column B, based on a file list in column A. Get the zipped sample file to create a comment with a picture from a file list. Go to Top
Sub InsertComment()
'www.contextures.com/xlcomments03.html
Dim rngList As Range
Dim c As Range
Dim cmt As Comment
Dim strPic As String
On Error Resume Next
Set rngList = Range("A1:A5")
strPic = "C:\Data\"
For Each c In rngList
With c.Offset(0, 1)
Set cmt = c.Comment
If cmt Is Nothing Then
Set cmt = .AddComment
End If
With cmt
.Text Text:=""
.Shape.Fill.UserPicture strPic & c.Value
.Visible = False
End With
End With
Next c
End Sub
Insert Selected Picture Into Comment
The following code creates a file from the selected picture, inserts it into a comment in the active cell, and deletes the picture. Get this sample file in the Downloads section
To use the macro:
- Select the cell where you want the comment with the picture
- Select the picture that you want in the comment
- Press Ctrl + Shift + P to run the macro
The active cell gets a comment with the selected picture, and the picture is deleted from the worksheet Go to Top
Sub PictureIntoComment()
' www.contextures.com
' puts the selected picture into
' a Note (legacy comment)
' in the active cell
Dim ch As ChartObject
Dim dWidth As Double
Dim dHeight As Double
Dim ws As Worksheet
Dim sName As String
Dim cmt As Comment
Dim sPath As String
Dim sFile As String
Dim rng As Range
Set ws = ActiveSheet
Dim pic As Object
Set rng = ActiveCell
Set pic = Selection
sPath = ThisWorkbook.Path & "\"
sName = "Picture_" _
& Format(Date, "yyyymmdd")
sFile = sPath & sName & ".gif"
dWidth = Selection.Width
dHeight = Selection.Height
Set ch = ws.ChartObjects _
.Add(Left:=rng.Left, _
Top:=rng.Top, _
Width:=dWidth, _
Height:=dHeight)
pic.Cut
ch.Activate
ActiveChart.Paste
rng.Activate
ch.Chart.Export sFile
ch.Delete
Set cmt = rng.AddComment
cmt.Text Text:=""
With cmt.Shape
.Fill.UserPicture sFile
.Width = dWidth
.Height = dHeight
End With
End Sub
Get the Sample Files
- Numbered Comments: Get the zipped sample file for numbered comments:
- For Excel 2007 and newer versions (includes code for merged cells): excelcommentsnumberprint.zip
- For Excel 2003 and older: CommentsNumberPrint.zip
- Triangle Shapes on Comments: Get the sample file for printing worksheet with triangle shapes on comments. The zipped Excel workbook is in xlsm format, and contains macros. Be sure to enable macros if you want to test the comment printing macros.
- Resize: Get the sample file with Comment Resizer code -- resize Excel comments in selected range, by area or resize by test cell row height. The zipped file is in xlsm format, and contains macros.
- Picture List: Get the zipped sample file to create a comment with a picture from a file list.
- Picture Selected on Sheet: Get the zipped sample file to create a file from the selected picture and insert it into a comment in the active cell.
Related Tutorials
Last updated: April 28, 2022 10:35 AM