Worksheets( 1 ).Range("a1").AddComment
        Worksheets( 1 ).Range("a1").Comment.Visible = False
        Worksheets( 1 ).Range("a1").Comment.Text Text:="Comment"
    

Sub ChgAllComments()
    Dim Cell As Range
    For Each Cell In Cells.SpecialCells(xlCellTypeComments)
        With Cell.Comment.Shape.TextFrame.Characters.Font
            .Size =  9 
        End With
    Next
End Sub

Public acVal

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    On Error Resume Next
    Target.AddComment
    Target.Comment.Text "Previous entry was " & acVal
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    If ActiveCell.Address <> Target.Address Then Exit Sub
    If Target.Value = "" Then
    	acVal = "" 
    Else
    	acVal = Target.Value
    End If
End Sub

Sub PictureIntoComment()
Dim ch As ChartObject
Dim dWidth As Double
Dim dHeight As Double
Dim ws As Worksheet
Dim sName As String
Dim cmt As Comment
Dim sPath As String
Dim sFile As String
Dim rng As Range
Set ws = ActiveSheet
Set rng = ActiveCell
sPath = ThisWorkbook.Path & "\"
sName = InputBox("Name for picture file (no extension)", "File Name")
If sName = "" Then sName = "Picture_" & Format(Date, "yyyymmdd")
sFile = sPath & sName & ".gif"

    dWidth = Selection.Width
    dHeight = Selection.Height
    
    Selection.Cut
    Set ch = ws.ChartObjects.Add(Left:=rng.Left, Top:=rng.Top, _
      Width:=dWidth, Height:=dHeight)
    ch.Chart.Paste
    rng.Activate
    ch.Chart.Export sFile
    ch.Delete
    Set cmt = rng.AddComment
    cmt.Text Text:=""
    With cmt.Shape
      .Fill.UserPicture sFile
      .Width = dWidth
      .Height = dHeight
    End With

End Sub  

Sub CopyCommentsToWord()

  Dim cmt As Comment
  Dim WdApp As Object

  On Error Resume Next
  Set WdApp = GetObject(, "Word.Application")
  If Err.Number <>  0  Then
    Err.Clear
    Set WdApp = CreateObject("Word.Application")
  End If

  With WdApp
    .Visible = True
    .Documents.Add DocumentType:= 0 

    For Each cmt In ActiveSheet.Comments
      .Selection.TypeText cmt.Parent.Address _
                            & vbTab & cmt.Text
      .Selection.TypeParagraph
    Next
  End With

  Set WdApp = Nothing

End Sub