パワーポイントの一部のワードを置換して、新しいファイルとして保存したいという相談を持ちかけられました。 ![](https://blogimg.goo.ne.jp/img_emoji/face_gaan.gif)
そんなの手動でやればいいじゃない!と返答したところ、100回の置換作業があるのに手動でやるのかと反論されてしまいました。
つまり、雛形のPowerPointファイルの一部だけを変えたものを100種類作って欲しいという要請だったのです。![](https://blogimg.goo.ne.jp/img_emoji/face_keibetsu.gif)
という事で、ExcelVBAでPowerPointファイルの連続処理プログラムを作る事にしました。
![](https://blog.goo.ne.jp/img_emoji/pc2.gif)
PowerPoint処理を自動化するのは初めてでしたが、MicrosoftOfficeのオブジェクト体系さえ分かれば何とかなる!と信じて突き進んでいたら、あっけなくできてしまいました。
尚、参考サイトは下記になります。
MicrosoftOfficeVBA(PowerPointVBA)オブジェクトモデル
また、完成したコードのポイントは下記の通り。
(PowerPointファイル処理部分のみを抜粋)
Dim objPowerpointApplication As Object Set objPowerpointApplication = CreateObject("Powerpoint.Application") objPowerpointApplication.Visible = True
'PowerpointFileNameに対象のパワーポイントファイルを指定する。 objPowerpointApplication.Presentations.Open Filename:=PowerpointFileName
Dim slide For Each slide In objPowerpointApplication.ActiveWindow.Parent.Slides Dim shape For Each shape In slide.Shapes If shape.HasTextFrame = msoTrue Then For Each word In shape.TextFrame.TextRange.Words word.Text = Replace(word.Text, "検索ワード" , "置換ワード") Next End If Next Next
'置換処理を終えたPowerPointファイルを上書き保存する。 objPowerpointApplication.ActivePresentation.Save
'PowerPointファイルを閉じる。 objPowerpointApplication.ActivePresentation.Close
'PowerPointアプリを閉じる。 objPowerpointApplication.Quit
'PowerPointオブジェクトをクリアする。 Set objPowerpointApplication = Nothing
|
以上を、毎度おなじみ!?のExcelVBAに組み込むことで、PowerPointの連続処理プログラムが完成しました。
あまり使う場面がないので、備忘録
として残しておきました。
尚、完成品をご入用であれば、直メしてください。