home *** CD-ROM | disk | FTP | other *** search
/ PC User 2004 August / Disc 1 / PCU0804CD1.iso / magstuff / QnA / files / excelmacro.txt next >
Encoding:
Text File  |  2004-06-07  |  1.1 KB  |  38 lines
  1. Sub AddFormulasToComments()
  2. Application.ScreenUpdating = False
  3. Dim CommentRange As Range, TargetCell As Range
  4. 'skip over errors caused by trying to delete comments in cells with no comments
  5. On Error Resume Next
  6. 'If the whole worksheet is selected, limit action to the used range.
  7. If Selection.Address = Cells.Address Then
  8. Set CommentRange = Range(ActiveSheet.UsedRange.Address)
  9. Else
  10. Set CommentRange = Range(Selection.Address)
  11. End If
  12. 'If the cell contains a formula, turn it into a comment.
  13. For Each TargetCell In CommentRange
  14. With TargetCell
  15. 'check whether the cell has a formula
  16. If Left(.Formula, 1) = "=" Then
  17. 'delete any existing comment
  18. .Comment.Delete
  19. 'add a new comment
  20. .AddComment
  21. 'copy the formula into the comment box
  22. .Comment.Text Text:=.Formula
  23. 'display the comment
  24. .Comment.Visible = True
  25. With .Comment.Shape
  26. 'automatically resizes the comment
  27. .TextFrame.AutoSize = True
  28. 'position the comment adjacent to its cell
  29. If TargetCell.Column < 254 Then.IncrementLeft -11.25
  30. If TargetCell.Row <> 1 Then .IncrementTop 8.25
  31. End With
  32. End If
  33. End With
  34. Next
  35. Application.ScreenUpdating = True
  36. End Sub
  37.  
  38.