Sub ListCommentsWithPageNumbers()

'
' ListCommentsWithPageNumbers Macro
' Macro created 20.03.2006 by Muhammet TURŞAK
'

    Dim count As Integer
    count = ActiveDocument.Comments.count
    Dim str As String
    str =""
    str = str & "=================================" & vbCrLf
    str = str & "BELGE YORUM LİSTESİ" & vbCrLf
    str = str & "-----------------------------------------------" & vbCrLf
    str = str & "Dosya                 : " & ActiveDocument.Path & vbCrLf
    str = str & "Listeleme Tarihi  : " & Now & vbCrLf
    str = str & "Kullanıcı             : " & Application.UserName & vbCrLf
    str = str & "===================================" & vbCrLf & vbCrLf & vbCrLf 

    For i = 1 To count
        Dim pageNo As Integer
        pageNo = ActiveDocument.Comments(i).Reference.Information(wdActiveEndAdjustedPageNumber)
        str = str & ActiveDocument.Comments.Item(i).range.Text & vbCrLf
        str = str & "Sayfa : " & pageNo & vbCrLf
        str = str & "______________________________ " & vbCrLf & vbCrLf
    Next     

    Dim d As Document
    Set d = Application.Documents.Add()
    d.range.Font.Name = "Arial"
    d.range.Font.Size = 10
    d.range.Text = ActiveDocument.range.Text & str

End Sub