サンプルコードでできること
コメントの一覧を作成します。
1列目 コメントの挿入ページ
2列目 作成者
3列目 コメントの付けられた文字列
4列目 コメント
Sub GetCommentList() 'コメントの一覧(ページ、作成者、コメントの付けられた文字列、コメント)を作成します。 Dim cmt As Comment Dim cmtList As String, docNew As Document For Each cmt In ActiveDocument.Comments With cmt cmtList = cmtList & .Reference.Information(wdActiveEndPageNumber) _ & vbTab & .Contact.Name & vbTab & _ cmt.Scope.Text & vbTab & .Range.Text & vbCrLf End With Next If cmtList = "" Then MsgBox "コメントはありません" Exit Sub Else '新規文書作成(数値は余白の数値) Set docNew = GetNewDocument(30, 30, 30, 30) docNew.Range.InsertBefore cmtList '選択テキストを表に変換 With Selection .WholeStory .ConvertToTable Separator:=wdSeparateByTabs .InsertRowsAbove 1 With .Tables(1).Range .Cells(1).Range.Text = "ページ" .Cells(2).Range.Text = "作成者" .Cells(3).Range.Text = "コメントが付けられた文字列" .Cells(4).Range.Text = "コメント" End With End With '表スタイル適用、列幅指定 With Selection.Tables(1) .Style = "表 (格子)" .ApplyStyleHeadingRows = True .PreferredWidthType = wdPreferredWidthPercent .PreferredWidth = 100 .Columns(1).PreferredWidth = 8 .Columns(2).PreferredWidth = 12 .Columns(3).PreferredWidth = 40 .Columns(4).PreferredWidth = 40 End With End If End Sub Private Function GetNewDocument(tMgn As Single, bMgn As Single, _ lMgn As Single, rMgn As Single) As Document '新規文書を作成します。 Dim dcNew As Document Set dcNew = Documents.Add With dcNew.PageSetup .TopMargin = MillimetersToPoints(30) .BottomMargin = MillimetersToPoints(30) .LeftMargin = MillimetersToPoints(30) .RightMargin = MillimetersToPoints(30) End With Set GetNewDocument = dcNew End Function