Via de website http://www.contextures.com/xlcomments03.html heb ik onderstaande 2 query gevonden en bewerkt alleen lukt het me niet om de query aan te passen zodat het op 2 cellen werkt.
Code:
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 = 5
shpH = 5
On Error Resume Next
For Each cmt In ws.Comments
'Set rngCmt = cmt.Parent
[COLOR="#FF0000"]Set rngCmt = Range("A1:A2")[/COLOR]
With rngCmt
Set shpCmt = ws.Shapes.AddShape(msoShapeRightTriangle, _
rngCmt.Offset(0, 1).Left - shpW, .Top, shpW, shpH)
End With
With shpCmt[COLOR="#FF0000"][/COLOR]
.Flip msoFlipVertical
.Flip msoFlipHorizontal
.Fill.ForeColor.RGB = RGB(192, 192, 192)
.Fill.Visible = msoTrue
.Fill.Solid
.Line.Visible = msoFalse
End With
Next cmt
End Sub
Code:
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
