Remove comment indicators (red triangles) with VBA

Question : Remove comment indicators (red triangles) with VBA

Hello, I would like to remove comment indicator autoshapes from a set of cells.  I would prefer to remove them rather than hide all indicators, so that I can choose to show some indicators and remove others.

I have tried the following subroutine, obtained from http://www.contextures.com/xlcomments03.html, but it does not seem to work (using Excel 2003):

Sub RemoveIndicatorShapes()

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

I also searched the worksheet shapes collection and did not find the triangle shapes, only the comment callouts.  Any input on this question would be greatly appreciated


 

Solution: Remove comment indicators (red triangles) with VBA

Here is a whacky idea: hide all the comment indicators and draw your own where you want them. Only problem with this solution is the comments won’t automatically appear when you mouse over the cell.

Public Sub AddCommentIndicators()

Dim IndicatorRange As Range
Dim Comment As Comment
Dim Shape As Shape
Dim Index As Long

Const ShapeName = “CommentIndicator”

For Each Shape In ActiveSheet.Shapes
If Left(Shape.Name, Len(ShapeName)) = ShapeName Then Shape.Delete
Next Shape

Set IndicatorRange = ActiveSheet.[A1:G5] ‘ change to include the cells in which you want indicators

Set Comment = ActiveSheet.[A1].Comment
If Len(Comment.Text) = 0 Then Set Comment = Comment.Next
Do
If Not Intersect(Comment.Parent, IndicatorRange) Is Nothing Then
With Comment.Parent.MergeArea
Set Shape = ActiveSheet.Shapes.AddShape(msoShapeRightTriangle, .Left + .Width – 3, .Top + 1, 3 / (ActiveWindow.Zoom / 100), 3 / (ActiveWindow.Zoom / 100))
Shape.Name = ShapeName & Index
Index = Index + 1
With Shape
.Line.ForeColor.SchemeColor = 10
.Fill.ForeColor.SchemeColor = 10
.Flip msoFlipVertical
.Flip msoFlipHorizontal
End With
End With
End If
Set Comment = Comment.Next
Loop Until Comment Is Nothing

End Sub