概要
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を学んで一発逆転のキャリアチェンジ!![](https://www11.a8.net/0.gif?a8mat=3TJ7ZU+CMV7Q2+4HUE+5ZMCI)
ここまで読んでいただき、ありがとうございました。
最後に宣伝をさせてください。
夢見るAIエンジニアへ、今こそ一歩を踏み出せ!
最近、AI技術やデータサイエンスに興味を持ち始めたあなた。将来、AIエンジニアやデータサイエンティストとして活躍したいと考えているかもしれません。また、AIを使って業務課題や研究課題を解決したい、あるいは教養としてAIの知識を深めたいと思っている方もいるでしょう。
しかし、学び始めるとなると「どこから手をつけて良いのか分からない」「専門的すぎて理解できない」といった悩みが生じることも。そんなあなたのために、この3ヶ月間集中してAIプログラミングを習得するオンラインコーチングサービスがオススメです!
なぜこのサービスが選ばれるのか?その理由はこちら
- 初心者から上級者まで
完全なプログラミング初心者から研究者まで、幅広い方々に優良なコンテンツが提供されます。 - 徹底的な進捗管理
受講者の進捗をしっかりとチェックし、つまずきやすいポイントでのフォローが万全です。 - 専属メンターによる徹底サポート
AIの学び方から、実際の適用まで、専属のメンターが手厚くサポートします。 - 場所を選ばず学べるオンライン完結
東京以外の地域からも、気軽に学び始めることができます。
信頼の実績多数!
・日本最大級のプログラミングスクール実績
・受講者総数700名以上
・SaaS型学習サービス会員65,000名以上
・企業導入実績120社以上
・グッドデザイン賞受賞
・著名な賞受賞歴や経団連加盟も実現
夢を叶えるための第一歩を、一緒に踏み出しませんか?今なら、あなたもその一員として学び始めることができます!