MENU
知の森へ
  1. ホーム
  2. VBAノート
  3. ExcelからPowerPointへグラフと表を貼り付けるVBAマクロの作成

ExcelからPowerPointへグラフと表を貼り付けるVBAマクロの作成

VBAノート
目次

概要

Excelに貼ってあるグラフや表をパワーポイントに展開したくて、今回やってみました。

全体のコード

以下は、ExcelからPowerPointへグラフと表を貼り付けるVBAコードです。

Sub ExportChartsAndTableToPowerPoint()
    ' PowerPointを操作するためのオブジェクト変数を宣言
    Dim pptApp As Object
    Dim pptPres As Object
    Dim pptSlide As Object
    Dim ws As Worksheet
    Dim chartObj1 As ChartObject
    Dim chartObj2 As ChartObject
    Dim chartObj3 As ChartObject
    Dim tableRange1 As Range
    Dim tableRange2 As Range
    Dim tableRange3 As Range
    Dim savePath As String
    Dim pptTable As Object
    Dim i As Long, j As Long
    Dim chartTop As Single, chartHeight As Single
    Dim chartWidth As Single
    
    ' グラフのサイズを設定（単位はポイント、1cm ≈ 28.3465ポイント）
    Dim chartHeightCm As Single
    Dim chartWidthCm As Single
    chartHeightCm = 10.3 * 28.3465
    chartWidthCm = 33.9 * 28.3465
    
    ' テキストボックスの幅を設定（単位はポイント、1cm ≈ 28.3465ポイント）
    Dim textBoxWidthCm As Single
    textBoxWidthCm = 20 * 28.3465
    
    ' Excelのワークシートを設定（適宜変更）
    Set ws = ThisWorkbook.Sheets("sheet1")
    
    ' 各グラフを設定（グラフの名前を適宜変更）
    Set chartObj1 = ws.ChartObjects("森")
    Set chartObj2 = ws.ChartObjects("林")
    Set chartObj3 = ws.ChartObjects("木")
    
    ' コピーする範囲を設定（適宜変更）
    Set tableRange1 = ws.Range("A1:B10")
    Set tableRange2 = ws.Range("A12:B22")
    Set tableRange3 = ws.Range("A24:B34")
    
    ' PowerPointを起動し、プレゼンテーションを作成
    On Error Resume Next
    Set pptApp = GetObject(Class:="PowerPoint.Application")
    If pptApp Is Nothing Then
        Set pptApp = CreateObject(Class:="PowerPoint.Application")
    End If
    On Error GoTo 0
    
    pptApp.Visible = True
    Set pptPres = pptApp.Presentations.Add
    
    ' スライド1にCO浄化率のグラフと表を追加
    Set pptSlide = pptPres.Slides.Add(1, 1) ' 1はppLayoutTextという定数
    With pptSlide.Shapes.Title
        .TextFrame.TextRange.Text = "森"
        .TextFrame.TextRange.Font.Size = 28
        .Left = 0
        .Top = 0
        .Width = textBoxWidthCm
        .Height = 50
        .TextFrame.TextRange.ParagraphFormat.Alignment = 1 ' 1はppAlignLeft
        .TextFrame.VerticalAnchor = 1 ' 1はmsoAnchorTop
    End With
    chartObj1.Chart.ChartArea.Copy
    pptSlide.Shapes.PasteSpecial DataType:=2 ' 2はppPasteEnhancedMetafileという定数
    With pptSlide.Shapes(pptSlide.Shapes.Count)
        .Left = 0
        .Top = 50 ' テキストボックスのすぐ下に配置
        .Width = chartWidthCm
        .Height = chartHeightCm
        chartTop = .Top
        chartHeight = .Height
    End With
    
    ' スライド1に表を追加
    Set pptTable = pptSlide.Shapes.AddTable(tableRange1.Rows.Count, tableRange1.Columns.Count, 0, chartTop + chartHeight, 500, 200).Table
    pptTable.Parent.Left = 0
    pptTable.Parent.Width = pptSlide.Master.Width
    For i = 1 To tableRange1.Rows.Count
        For j = 1 To tableRange1.Columns.Count
            pptTable.Cell(i, j).Shape.TextFrame.TextRange.Text = tableRange1.Cells(i, j).Text
            pptTable.Cell(i, j).Shape.TextFrame.TextRange.Font.Size = 12
        Next j
    Next i
    
    ' スライド2にTHC浄化率のグラフと表を追加
    Set pptSlide = pptPres.Slides.Add(2, 1)
    With pptSlide.Shapes.Title
        .TextFrame.TextRange.Text = "林"
        .TextFrame.TextRange.Font.Size = 28
        .Left = 0
        .Top = 0
        .Width = textBoxWidthCm
        .Height = 50
        .TextFrame.TextRange.ParagraphFormat.Alignment = 1 ' 1はppAlignLeft
        .TextFrame.VerticalAnchor = 1 ' 1はmsoAnchorTop
    End With
    chartObj2.Chart.ChartArea.Copy
    pptSlide.Shapes.PasteSpecial DataType:=2
    With pptSlide.Shapes(pptSlide.Shapes.Count)
        .Left = 0
        .Top = 50 ' テキストボックスのすぐ下に配置
        .Width = chartWidthCm
        .Height = chartHeightCm
        chartTop = .Top
        chartHeight = .Height
    End With
    
    ' スライド2に表を追加
    Set pptTable = pptSlide.Shapes.AddTable(tableRange2.Rows.Count, tableRange2.Columns.Count, 0, chartTop + chartHeight, 500, 200).Table
    pptTable.Parent.Left = 0
    pptTable.Parent.Width = pptSlide.Master.Width
    For i = 1 To tableRange2.Rows.Count
        For j = 1 To tableRange2.Columns.Count
            pptTable.Cell(i, j).Shape.TextFrame.TextRange.Text = tableRange2.Cells(i, j).Text
            pptTable.Cell(i, j).Shape.TextFrame.TextRange.Font.Size = 12
        Next j
    Next i
    
    ' スライド3にNox浄化率のグラフと表を追加
    Set pptSlide = pptPres.Slides.Add(3, 1)
    With pptSlide.Shapes.Title
        .TextFrame.TextRange.Text = "木"
        .TextFrame.TextRange.Font.Size = 28
        .Left = 0
        .Top = 0
        .Width = textBoxWidthCm
        .Height = 50
        .TextFrame.TextRange.ParagraphFormat.Alignment = 1 ' 1はppAlignLeft
        .TextFrame.VerticalAnchor = 1 ' 1はmsoAnchorTop
    End With
    chartObj3.Chart.ChartArea.Copy
    pptSlide.Shapes.PasteSpecial DataType:=2
    With pptSlide.Shapes(pptSlide.Shapes.Count)
        .Left = 0
        .Top = 50 ' テキストボックスのすぐ下に配置
        .Width = chartWidthCm
        .Height = chartHeightCm
        chartTop = .Top
        chartHeight = .Height
    End With
    
    ' スライド3に表を追加
    Set pptTable = pptSlide.Shapes.AddTable(tableRange3.Rows.Count, tableRange3.Columns.Count, 0, chartTop + chartHeight, 500, 200).Table
    pptTable.Parent.Left = 0
    pptTable.Parent.Width = pptSlide.Master.Width
    For i = 1 To tableRange3.Rows.Count
        For j = 1 To tableRange3.Columns.Count
            pptTable.Cell(i, j).Shape.TextFrame.TextRange.Text = tableRange3.Cells(i, j).Text
            pptTable.Cell(i, j).Shape.TextFrame.TextRange.Font.Size = 12
        Next j
    Next i
    
    ' Excelと同じディレクトリに保存
    savePath = ThisWorkbook.Path & "\ExportedPresentation.pptx"
    pptPres.SaveAs savePath
    
    ' リソースの解放
    Set pptSlide = Nothing
    Set pptPres = Nothing
    Set pptApp = Nothing
    
    ' 完了メッセージを表示
    MsgBox "パワーポイントの作成が完了しました。", vbInformation
End Sub

セクションごとの説明

PowerPointの起動

まず、PowerPointアプリケーションを起動し、新しいプレゼンテーションを作成します。以下のコードは、この操作を実行します。

' PowerPointを起動し、プレゼンテーションを作成
On Error Resume Next
Set pptApp = GetObject(Class:="PowerPoint.Application")
If pptApp Is Nothing Then
    Set pptApp = CreateObject(Class:="PowerPoint.Application")
End If
On Error GoTo 0

pptApp.Visible = True
Set pptPres = pptApp.Presentations.Add

この部分では、PowerPointアプリケーションを取得または新規作成し、それを表示して新しいプレゼンテーションを作成しています。

テキストボックスの作成

次に、スライドにテキストボックスを作成します。このテキストボックスはスライドのタイトルになります。

' スライド1にCO浄化率のグラフと表を追加
Set pptSlide = pptPres.Slides.Add(1, 1) ' 1はppLayoutTextという定数
With pptSlide.Shapes.Title
    .TextFrame.TextRange.Text = "森"
    .TextFrame.TextRange.Font.Size = 28
    .Left = 0
    .Top = 0
    .Width = textBoxWidthCm
    .Height = 50
    .TextFrame.TextRange.ParagraphFormat.Alignment = 1 ' 1はppAlignLeft
    .TextFrame.VerticalAnchor = 1 ' 1はmsoAnchorTop
End With

この部分では、スライドを追加し、そのタイトルとしてテキストボックスを設定しています。フォントサイズや位置、大きさもここで設定します。

グラフの貼り付け

次に、Excelからグラフをコピーし、PowerPointのスライドに貼り付けます。

Dim ws As Worksheet
Dim chartObj1 As ChartObject

' Excelのワークシートを設定
Set ws = ThisWorkbook.Sheets("Sheet1")
Set chartObj1 = ws.ChartObjects("森")

chartObj1.Chart.ChartArea.Copy
pptSlide.Shapes.PasteSpecial DataType:=2 ' 2はppPasteEnhancedMetafileという定数
With pptSlide.Shapes(pptSlide.Shapes.Count)
    .Left = 0
    .Top = 50 ' テキストボックスのすぐ下に配置
    .Width = chartWidthCm
    .Height = chartHeightCm
    chartTop = .Top
    chartHeight = .Height
End With

この部分では、指定したExcelのグラフをコピーし、PowerPointに貼り付けています。貼り付け位置とサイズもここで設定します。

表の貼り付け

最後に、Excelから表をコピーし、PowerPointのスライドに貼り付けます。

Dim tableRange1 As Range
Dim pptTable As Object
Dim i As Long, j As Long

' コピーする範囲を設定
Set tableRange1 = ws.Range("A1:B10")

' スライド1に表を追加
Set pptTable = pptSlide.Shapes.AddTable(tableRange1.Rows.Count, tableRange1.Columns.Count, 0, chartTop + chartHeight, 500, 200).Table
pptTable.Parent.Left = 0
pptTable.Parent.Width = pptSlide.Master.Width
For i = 1 To tableRange1.Rows.Count
    For j = 1 To tableRange1.Columns.Count
        pptTable.Cell(i, j).Shape.TextFrame.TextRange.Text = tableRange1.Cells(i, j).Text
        pptTable.Cell(i, j).Shape.TextFrame.TextRange.Font.Size = 12
    Next j
Next i

この部分では、指定した範囲の表をPowerPointのスライドに貼り付けています。セルの内容とフォントサイズもここで設定します。

完成メッセージの表示

最後に、作業が完了したことをユーザーに通知するメッセージを表示します。

' 完了メッセージを表示
MsgBox "パワーポイントの作成が完了しました。", vbInformation
End Sub

これで、Excelのグラフと表をPowerPointに自動的に貼り付けるVBAマクロが完成です。このマクロを使えば、手作業でのコピーペースト作業を省略でき、効率的にプレゼンテーションを作成することができます。

以上です。

スクールの紹介

ここまで読んでいただき、ありがとうございました。

最後に宣伝をさせてください。

夢見るAIエンジニアへ、今こそ一歩を踏み出せ！

最近、AI技術やデータサイエンスに興味を持ち始めたあなた。将来、AIエンジニアやデータサイエンティストとして活躍したいと考えているかもしれません。また、AIを使って業務課題や研究課題を解決したい、あるいは教養としてAIの知識を深めたいと思っている方もいるでしょう。

しかし、学び始めるとなると「どこから手をつけて良いのか分からない」「専門的すぎて理解できない」といった悩みが生じることも。そんなあなたのために、この3ヶ月間集中してAIプログラミングを習得するオンラインコーチングサービスがオススメです！

なぜこのサービスが選ばれるのか？その理由はこちら

  1. 初心者から上級者まで
    完全なプログラミング初心者から研究者まで、幅広い方々に優良なコンテンツが提供されます。
  2. 徹底的な進捗管理
    受講者の進捗をしっかりとチェックし、つまずきやすいポイントでのフォローが万全です。
  3. 専属メンターによる徹底サポート
    AIの学び方から、実際の適用まで、専属のメンターが手厚くサポートします。
  4. 場所を選ばず学べるオンライン完結
    東京以外の地域からも、気軽に学び始めることができます。

信頼の実績多数！
・日本最大級のプログラミングスクール実績
・受講者総数700名以上
・SaaS型学習サービス会員65,000名以上
・企業導入実績120社以上
・グッドデザイン賞受賞
・著名な賞受賞歴や経団連加盟も実現

夢を叶えるための第一歩を、一緒に踏み出しませんか？今なら、あなたもその一員として学び始めることができます！

VBAノート
VBA PowerPoint
よかったらシェアしてね！
  • URLをコピーしました！
  • URLをコピーしました！

この記事を書いた人

morishuheiのアバター morishuhei

私が勉強したこと、実践したこと、してることを書いているブログです。
主に資産運用について書いていたのですが、
最近はプログラミングに興味があるので、今はそればっかりです。

関連記事

目次