コメント一覧を新規Excelブックに作成するWordマクロ

　Dim xls As Object　' Application.Excel
　Dim arr()　　　　　' ページ番号, 行番号, 本文のセンテンス, コメント文字列
　Dim cnt As Long　' コメント数
　Dim i As Long

　With ActiveDocument.Comments
　　cnt = .Count
　　If cnt = 0 Then
　　　MsgBox "アクティブ文書にコメントは存在しません"
　　　Exit Sub
　　End If
　　ReDim arr(1 To cnt, 1 To 4)
　　For i = 1 To cnt
　　　With .Item(i)
　　　　With .Reference
　　　　　arr(i, 1) = .Information(wdActiveEndAdjustedPageNumber)
　　　　　arr(i, 2) = .Information(wdFirstCharacterLineNumber)
　　　　　arr(i, 3) = .Sentences(1).Text
　　　　End With　' .Reference
　　　　arr(i, 4) = .Range.Text
　　　End With　' .Item(i)
　　Next i
　End With　' ActiveDocument.Comments

　Set xls = CreateObject("Excel.Application")
　With xls
　　.Workbooks.Add
　　.Range("A1").Value = ActiveDocument.Name
　　.Range("A2").Value = "ページ番号"
　　.Range("B2").Value = "行番号"
　　.Range("C2").Value = "本文のセンテンス"
　　.Range("D2").Value = "コメント文字列"
　　.Range("A1:D2").Font.Bold = True
　　.Range(.Cells(3, "A"), .Cells(cnt + 2, "D")).Value = arr()
　　.Range("A:B").EntireColumn.ColumnWidth = 10
　　.Range("C:D").EntireColumn.ColumnWidth = 50
　　.Visible = True
　End With　' xls
　Set xls = Nothing