Prev Previous Post   Next Post Next
  #1   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 16
Default macro trouble

Hi,
I copied the two macros below from http://contextures.com/xlcomments03.html.
one macro places numbers over the triangles of my comments and the other
lists the comments on a separate worksheet. I wanted this so that I could
print both out and be able to refer to the comment list when looking at the
printed spreadsheet. however, the list doesn't match up with the numbers
covering the comment triangles on the spreadsheet. Can anyone help me with
this?

thanks
Jen

MACRO TO NUMBER COMMENTS
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
End With
lCmt = lCmt + 1
Next cmt

End Sub


MACRO TO LIST COMMENTS

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("Number", "Name", "Value", "Comment")

i = 1
For Each mycell In commrange
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 = mycell.Value
.Cells(i, 4).Value = Replace(mycell.Comment.Text, Chr(10), " ")
End With
Next mycell
newwks.Cells.WrapText = False
newwks.Columns.AutoFit

Application.ScreenUpdating = True

End Sub
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
MACRO TROUBLE HELP Excel Discussion (Misc queries) 2 June 7th 06 04:09 PM
Still having trouble scott Excel Discussion (Misc queries) 3 May 17th 06 08:01 PM
dim trouble jocke Excel Discussion (Misc queries) 7 October 6th 05 08:55 PM
still having trouble with this.... nick Excel Worksheet Functions 4 March 13th 05 07:40 PM
trouble with add ins caia Excel Discussion (Misc queries) 1 February 16th 05 01:17 AM


All times are GMT +1. The time now is 05:55 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"