【ExcelVBA・マクロ】PowerPointを自動操作する方法|表・グラフからスライドを自動生成するVBAコード【コピペOK】

ExcelVBA

売上レポートや進捗報告など、Excelで集計した表やグラフを毎回PowerPointに手作業でコピー&ペーストしていませんか。この記事では、ExcelVBAからPowerPoint.Applicationを操作し、スライドの自動生成・表やグラフの貼り付け・ファイル保存までを自動化する方法を解説します。定型フォーマットの報告資料作成を大幅に効率化できます。

スポンサーリンク
スポンサーリンク

PowerPointをVBAから操作する準備

ExcelからPowerPointを操作するには、CreateObject("PowerPoint.Application")を使う「実行時バインディング(遅延バインディング)」が便利です。VBEの「参照設定」で”Microsoft PowerPoint XX.0 Object Library”にチェックを入れる「事前バインディング」も可能ですが、相手のPCのPowerPointバージョンによってエラーになることがあるため、配布用マクロではCreateObjectを使う方法をおすすめします。

Sub OpenPowerPointApp()
    Dim ppApp As Object

    Set ppApp = CreateObject("PowerPoint.Application")
    ppApp.Visible = True
End Sub

ppApp.Visible = Trueを指定すると、処理中のPowerPoint画面が表示されるため、動作確認がしやすくなります。

新しいプレゼンテーションを作成してスライドを追加する

Presentations.Addで新規プレゼンテーションを作成し、Slides.Addでスライドを追加します。第2引数にはスライドのレイアウト番号(PpSlideLayout)を指定します。遅延バインディングでは列挙定数が使えないため、あらかじめConstで数値を定義しておくと分かりやすくなります。

Sub CreateNewPresentation()
    Dim ppApp As Object
    Dim ppPres As Object
    Dim ppSlide As Object

    Const ppLayoutTitleOnly As Long = 11

    Set ppApp = CreateObject("PowerPoint.Application")
    ppApp.Visible = True

    Set ppPres = ppApp.Presentations.Add
    Set ppSlide = ppPres.Slides.Add(1, ppLayoutTitleOnly)
End Sub

タイトルと本文を自動入力する

スライドにタイトル用のプレースホルダーがある場合は、Shapes.Titleからテキストを設定できます。本文はテキストボックスを追加して入力します。

Sub AddTitleAndText()
    Dim ppApp As Object
    Dim ppPres As Object
    Dim ppSlide As Object
    Dim txtBox As Object

    Const ppLayoutTitleOnly As Long = 11
    Const msoTextOrientationHorizontal As Long = 1

    Set ppApp = CreateObject("PowerPoint.Application")
    ppApp.Visible = True
    Set ppPres = ppApp.Presentations.Add
    Set ppSlide = ppPres.Slides.Add(1, ppLayoutTitleOnly)

    ppSlide.Shapes.Title.TextFrame.TextRange.Text = "月次売上レポート"

    Set txtBox = ppSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, 50, 120, 600, 60)
    txtBox.TextFrame.TextRange.Text = "作成日: " & Format(Date, "yyyy年mm月dd日")
End Sub

AddTextboxの引数は「向き・Left・Top・Width・Height」の順です。ポイント単位(1インチ=72ポイント)で位置とサイズを指定します。

Excelの表をスライドに貼り付ける方法

Excelのセル範囲を画像としてコピーし、スライドに貼り付けるにはRange.CopyPictureShapes.Pasteを組み合わせます。

Sub PasteRangeToSlide()
    Dim ppApp As Object
    Dim ppPres As Object
    Dim ppSlide As Object
    Dim ws As Worksheet
    Dim rng As Range
    Dim pastedShape As Object

    Const ppLayoutBlank As Long = 12

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set rng = ws.Range("A1:D10")
    rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture

    Set ppApp = CreateObject("PowerPoint.Application")
    ppApp.Visible = True
    Set ppPres = ppApp.Presentations.Add
    Set ppSlide = ppPres.Slides.Add(1, ppLayoutBlank)

    ppSlide.Shapes.Paste
    Set pastedShape = ppSlide.Shapes(ppSlide.Shapes.Count)
    pastedShape.Left = 50
    pastedShape.Top = 80
End Sub

Shapes.Pasteで貼り付けた図形はスライド内で一番最後の要素になるため、Shapes(Shapes.Count)で取得して位置を調整しています。

Excelのグラフをスライドに貼り付ける方法

グラフも同様に、ChartArea.CopyでコピーしてからShapes.Pasteで貼り付けられます。

Sub PasteChartToSlide()
    Dim ppApp As Object
    Dim ppPres As Object
    Dim ppSlide As Object
    Dim cht As Chart
    Dim pastedShape As Object

    Const ppLayoutBlank As Long = 12

    Set cht = ThisWorkbook.Worksheets("Sheet1").ChartObjects(1).Chart
    cht.ChartArea.Copy

    Set ppApp = CreateObject("PowerPoint.Application")
    ppApp.Visible = True
    Set ppPres = ppApp.Presentations.Add
    Set ppSlide = ppPres.Slides.Add(1, ppLayoutBlank)

    ppSlide.Shapes.Paste
    Set pastedShape = ppSlide.Shapes(ppSlide.Shapes.Count)
    pastedShape.Left = 50
    pastedShape.Top = 80
End Sub

グラフはChartObjects(1)のようにインデックスで指定するほか、ChartObjects("グラフ1").Chartのように名前で指定することもできます。

完成したプレゼンテーションを保存する

作成したプレゼンテーションはSaveAsメソッドで保存します。保存後にQuitでPowerPointを終了させれば、バックグラウンドにプロセスが残りません。

Sub SavePresentation()
    Dim ppApp As Object
    Dim ppPres As Object

    Const ppLayoutTitleOnly As Long = 11

    Set ppApp = CreateObject("PowerPoint.Application")
    ppApp.Visible = True
    Set ppPres = ppApp.Presentations.Add
    ppPres.Slides.Add 1, ppLayoutTitleOnly

    ppPres.SaveAs "C:\Reports\月次売上レポート.pptx"
    ppPres.Close
    ppApp.Quit
    Set ppPres = Nothing
    Set ppApp = Nothing
End Sub

実務での活用例:表とグラフをまとめてレポート化する

ここまでの処理を1つのマクロにまとめると、Excelのボタン1つで「タイトルスライド+表+グラフ」のレポートを自動生成できます。

Sub CreateSalesReport()
    Dim ppApp As Object
    Dim ppPres As Object
    Dim titleSlide As Object
    Dim dataSlide As Object
    Dim chartSlide As Object
    Dim ws As Worksheet
    Dim rng As Range
    Dim cht As Chart
    Dim pastedShape As Object

    Const ppLayoutTitleOnly As Long = 11
    Const ppLayoutBlank As Long = 12

    Set ws = ThisWorkbook.Worksheets("Sheet1")

    Set ppApp = CreateObject("PowerPoint.Application")
    ppApp.Visible = True
    Set ppPres = ppApp.Presentations.Add

    ' 1枚目: タイトルスライド
    Set titleSlide = ppPres.Slides.Add(1, ppLayoutTitleOnly)
    titleSlide.Shapes.Title.TextFrame.TextRange.Text = "月次売上レポート"

    ' 2枚目: 表を貼り付け
    Set rng = ws.Range("A1:D10")
    rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Set dataSlide = ppPres.Slides.Add(2, ppLayoutBlank)
    dataSlide.Shapes.Paste
    Set pastedShape = dataSlide.Shapes(dataSlide.Shapes.Count)
    pastedShape.Left = 50
    pastedShape.Top = 80

    ' 3枚目: グラフを貼り付け
    Set cht = ws.ChartObjects(1).Chart
    cht.ChartArea.Copy
    Set chartSlide = ppPres.Slides.Add(3, ppLayoutBlank)
    chartSlide.Shapes.Paste
    Set pastedShape = chartSlide.Shapes(chartSlide.Shapes.Count)
    pastedShape.Left = 50
    pastedShape.Top = 80

    ppPres.SaveAs "C:\Reports\月次売上レポート.pptx"

    MsgBox "レポートを作成しました。"
End Sub

シート名やセル範囲、保存先フォルダは環境に合わせて書き換えて使ってください。

まとめ

  • CreateObject("PowerPoint.Application")を使えば参照設定なしでPowerPointを操作できる
  • Presentations.AddSlides.Addで新規プレゼンテーションとスライドを作成できる
  • Range.CopyPictureShapes.PasteでExcelの表を画像としてスライドに貼り付けられる
  • ChartArea.CopyShapes.Pasteでグラフも同様にスライドへ貼り付けられる
  • SaveAsで保存し、Quitで確実にPowerPointを終了させる

毎月・毎週の定型レポート作成をVBAで自動化すれば、資料作成の手間を大きく減らせます。ぜひ自分の業務のフォーマットに合わせてカスタマイズしてみてください。

スポンサーリンク
スポンサーリンク
ExcelVBA
シェアする
いがぴをフォローする

コメント

タイトルとURLをコピーしました