Sub MakeCommentsFootnotes() 
    Dim aDoc As Document 
    Dim i As Integer 
    Dim cCount As Integer 
    Dim strComment As String 
    Dim r As Range 
    Dim var 
    Dim var2 
     
    Set aDoc = ActiveDocument 
     
    Selection.HomeKey Unit:=wdStory 
    i = 1 
    On Error Resume Next 
    For var2 = 1 To aDoc.BuiltInDocumentProperties(wdPropertyPages) 
         ' select current page
         
        Set r = aDoc.Range(Start:=aDoc.Bookmarks("\page").Start, _ 
        End:=aDoc.Bookmarks("\page").End) 
         ' get a count of comments on the page
        cCount = r.Comments.Count 
         
        If cCount > 0 Then 
             ' collapse selection to keep it on same page
            Selection.Collapse direction:=wdCollapseStart 
            For var = 1 To cCount 
                 ' select LAST comment on page as
                 ' footnotes list in reverse order
                aDoc.Comments(i + (cCount - 1)).Range.Select 
                 ' set string for comment text
                strComment = Selection.Text 
                 
                 ' close the comments pane to allow editing
                ActiveWindow.ActivePane.Close 
                If ActiveWindow.View.SplitSpecial = wdPaneNone Then 
                    ActiveWindow.ActivePane.View.Type = wdPrintView 
                Else 
                    ActiveWindow.View.Type = wdPrintView 
                End If 
                 
                 ' use current page range to set footnote
                With aDoc.Range(Start:=aDoc.Bookmarks("\page").Range.Start, End:= _ 
                    aDoc.Bookmarks("\page").End) 
                    With .FootnoteOptions 
                        .Location = wdBottomOfPage 
                        .NumberingRule = wdRestartContinuous 
                        .StartingNumber = 1 
                        .NumberStyle = wdNoteNumberStyleArabic 
                    End With 
                    .Footnotes.Add Range:=Selection.Range, Reference:="" 
                End With 
                Selection.TypeText Text:=strComment 
                i = i - 1 
            Next ' next comment on current page
        Else 
        End If 
         ' go to next page
        Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Count:=1, Name:="" 
        i = ((aDoc.Comments.Count - cCount) + 1) 
    Next 
    Set aDoc = Nothing 
End Sub