コメントを別紙に書き出す
2020年12月02日
前回に引き続き、ワードマクロ消えちゃった企画第三弾。
今回は、ワードのコメントを新しいドキュメントに転記するマクロ。
関係者とコメントの追記合戦をしていると、
返信の返信の返信とかで、ぐちゃぐちゃになってくる。
で、各コメントの対応が完了したかチェックリストを作ることになるので
それを自動的につくるためのマクロ。
他にもコメントプロパティで記入者とか取得できるけど、
出力がごちゃごちゃすると使いづらいのでこの内容だけ共有した。
以下、ソース
今回は、ワードのコメントを新しいドキュメントに転記するマクロ。
関係者とコメントの追記合戦をしていると、
返信の返信の返信とかで、ぐちゃぐちゃになってくる。
で、各コメントの対応が完了したかチェックリストを作ることになるので
それを自動的につくるためのマクロ。
他にもコメントプロパティで記入者とか取得できるけど、
出力がごちゃごちゃすると使いづらいのでこの内容だけ共有した。
以下、ソース
Sub コメントを別紙に書き出すマクロ_nPTC_v09r00()
'ページ 対象部分 コメント
Dim i As Integer
Dim actDoc As Document
Dim newDoc As Document
Dim myTable As Table
If ActiveDocument.Comments.Count = 0 Then Exit Sub
Set actDoc = ActiveDocument
Set newDoc = Documents.Add '新ドキュメントを作成
With ActiveDocument.PageSetup
.TopMargin = MillimetersToPoints(15) '上余白
.BottomMargin = MillimetersToPoints(15) '下余白
.LeftMargin = MillimetersToPoints(6) '左余白
.RightMargin = MillimetersToPoints(6) '右余白
End With
Selection.TypeText Text:=Format(Date + 1, "ggge年m月d日") '日付を入力
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight '右揃え
Selection.TypeParagraph
Selection.TypeText Text:=actDoc 'タイトルはファイル名
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter '中央揃え
Selection.TypeParagraph '改行
Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft '左揃え
Selection.TypeParagraph '改行
Set myTable = newDoc.Tables.Add(Range:=Selection.Range, _
NumRows:=actDoc.Comments.Count + 1, NumColumns:=4) 'タイトル行で＋１
myTable.Cell(1, 1).Range.Text = "#"
myTable.Cell(1, 2).Range.Text = "Page"
myTable.Cell(1, 3).Range.Text = "対象部分"
myTable.Cell(1, 4).Range.Text = "コメント"
For i = 1 To actDoc.Comments.Count 'テーブルに書き込み
With actDoc.Comments(i)
myTable.Cell(i + 1, 1).Range.Text = i
myTable.Cell(i + 1, 2).Range.Text = .Scope.Information(wdActiveEndPageNumber)
myTable.Cell(i + 1, 3).Range.Text = .Scope.Text
myTable.Cell(i + 1, 4).Range.Text = .Range.Text
End With
Next i
With myTable
.Style = "表 (格子)"
.AutoFitBehavior (wdAutoFitContent)
End With
Set actDoc = Nothing
Set newDoc = Nothing
End Sub
PR
Comment