コメントをExcelに出力するPowerPointマクロ
プレミアがついていて買えなかった倉橋ヨエコの『婦人用』を、電子データで購入しました。良い時代になりました。手元にCDがないのはありえない派だった私も丸くなりました。『金魚想う』がくどくて湿っぽくてくせになります。
前回の記事の最後で少し触れた、PowerPointのコメントをExcelに出力するマクロをご紹介します。
実行前
実行後
イミディエイトウィンドウに出力するときには、各コメントの要素をつなぎ合わせてコメントごとに1つの文字列にし、改行で分割して表示していましたが、これをそのままExcelに出力してもあまり意味がありません。Excelを使うからには情報をセルに格納したいので、各要素を格納した配列を作り、それをExcelに渡してセルに入力します。
Option Explicit
Sub CommentsToExcel()
''コメントをエクセルに出力
Dim CmtArray()
Dim myslides As Slides
Dim myslide As Slide
Dim mycomment As Comment
Dim CmtNum As Integer
Dim EXLS As Object
Dim m As Integer
Dim n As Integer
''初期化
CmtNum = 0
m = 1
n = 1
''ppt上のコメントを配列に格納
Set myslides = ActivePresentation.Slides
For Each myslide In myslides
For Each mycomment In myslide.Comments
CmtNum = CmtNum + 1
ReDim Preserve CmtArray(4, CmtNum)
CmtArray(1, CmtNum) = myslide.SlideNumber
CmtArray(2, CmtNum) = mycomment.Author
CmtArray(3, CmtNum) = mycomment.DateTime
CmtArray(4, CmtNum) = mycomment.Text
Next mycomment
Next myslide
If CmtNum = 0 Then
MsgBox ("コメントはありません。" & vbCrLf & "処理を終了します。")
Exit Sub
End If
''エクセルを起動
Set EXLS = CreateObject("Excel.Application")
EXLS.Visible = True
EXLS.Workbooks.Add
''表のタイトルを作成
With EXLS.ActiveSheet
.Cells(1, 1).Value = "項番"
.Cells(1, 2).Value = "SlideNo."
.Cells(1, 3).Value = "Author"
.Cells(1, 4).Value = "DateTime"
.Cells(1, 5).Value = "Comment"
''配列の中身を移す
Do While m <= CmtNum
.Cells(m + 1, 1).Value = m
For n = 2 To 5 Step 1
.Cells(m + 1, n).Value = CmtArray(n - 1, m)
Next
m = m + 1
Loop
''整形
.Range("A1:E" & m).Borders.LineStyle = True
.Range("A1:E" & m).Font.Size = 10
.Range("A1:E1").Interior.ColorIndex = 37
.Range("A1:E1").HorizontalAlignment = xlCenter
.Columns("A:D").EntireColumn.Autofit
.Columns("E:E").ColumnWidth = 60
.Range("E:E").WrapText = True
End With
''掃除
Set EXLS = Nothing
Erase CmtArray
End Sub
美しいコードではありませんが、目的を満たしているので個人的にはこれで十分です。
----------お知らせ----------
株式会社シーブレインでは、フリーランス翻訳者を募集しています。
リンク先のページに記載されている説明をお読みいただき、要項に従ってご応募ください。
みなさまからのチャレンジをお待ちしております！
