Numbering Comments

[ttratl]

Hi Everyone,

I have this code in Module 1 of my workbook:

Option Explicit
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 = _
    msoShapeRectangle Then
    shp.Delete
  End If
End If
Next shp

End Sub

Sub CoverCommentIndicator()
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
    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 = 4
      .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

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:D1").Value = _
         Array("Number", "Name", "Value", "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

These macros insert a numbered rectangle over the red comment flags (so you can see the cells with comments when printing), remove the numbered rectangles, and the 3rd macro lists all the comments on a seperate worksheet.
They all work fine in the downloaded file from Contextures, but in my workbook the 'remove rectangles' code fails at

If Not shp.TopLeftCell.Comment Is Nothing Then

Any ideas why this should happen?
I have the code in Module 1, because that's where it is in the working file. I don't have any other code running in this file. I'm baffled!

 

[Andrew Poulsom]

What error do you get?

 

[ttratl]

I get the MS VB error dialog saying Run-time error '1004'. 'Application-defined or object-defined error'.
When clicking De-bug it highlights the VB line mentioned above.

 

[Andrew Poulsom]

If you put this before the offending line:

MsgBox shp.TopLeftCell.Address

do you get an error?

 

[ttratl]

Hi Paul,

Still errors - but slightly differently:

I get a simple MS Excel dialog message saying "$e$9" with an OK button.
Click once changes it to "$e$11", then to "$e$13", then errors straight to this new line in VB.

I don't have anything in any of these cell references...

 

[Andrew Poulsom]

That's not an error. I just wanted to see if it was the shape's TopLeftCell property that was causing a problem. Do you by any chance have Data Validation in E9, E11, E13?

 

[ttratl]

I don't have Data Validation in column E, but I do in some other columns.

I was just playing around with it, still with your extra line, and now those cell references only refer to column D cells, where I do have DV. Is this the problem d'you think?

 

[ttratl]

Paul - Apologies - I don't have DV in column D.

I do have DV on other columns. None of the DV cells have comments in them.

 

[ttratl]

Just inserted some Data Validation on the working file and it failed at the same line. So it is the DV. How annoying .

 

[Andrew Poulsom]

Try:

Sub Test()
    Dim ws As Worksheet
    Dim shp As Shape
    Set ws = ActiveSheet
    For Each shp In ws.Shapes
        If shp.Type <> msoFormControl Then
            If Not shp.TopLeftCell.Comment Is Nothing Then
                If shp.AutoShapeType = _
                    msoShapeRectangle Then
                shp.Delete
                End If
            End If
        End If
    Next shp
End Sub