VBAで表やグラフをPowerPointへ貼り付ける

公開日：2020-06-19　最終更新日：2020-06-22

VBAで表やグラフをPowerPointへ貼り付ける

エクセルのグラフや表範囲をパワーポイントへ貼り付ける方法の解説です。
1つ2つの貼り付けを単発で行うのであれば手作業でも良いですが、
何十個も、そして、何回も貼り付けを行うのであればマクロVBAで自動化したいところです。

エクセル

パワーポイント
VBA マクロ表グラフ PowerPoint 貼り付け

表やグラフをPowerPointへ貼り付けるVBA


  
    
      Sub sample()

　　Dim ppApp As New PowerPoint.Application

　　Dim ppPt As Presentation

　　Dim ppSlide As Slide

　　Dim ppShape As PowerPoint.Shape

　　'ppApp.Visible = True 'PowerPoint2007以前の場合は有効にしてください。

　　Set ppPt = ppApp.Presentations.Open(ThisWorkbook.Path & "\sample.pptx")

　　

　　'スライド番号1を指定

　　Set ppSlide = ppPt.Slides(1)

　　

　　Dim ws As Worksheet

　　Set ws = ThisWorkbook.Worksheets("Sheet1")

　　'セル範囲を画像で貼りつけ

　　ws.Range("A1").CurrentRegion.Copy

　　'PasteSpeciaでエラーが出るときは、ここに待ちを作ります。

　　ppSlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile, Link:=msoFalse

　　Set ppShape = ppSlide.Shapes(ppSlide.Shapes.Count) '最後の図形

　　ppShape.Top = Application.CentimetersToPoints(1) '上位置

　　ppShape.Left = Application.CentimetersToPoints(1) '左位置

　　ppShape.LockAspectRatio = msoTrue '縦横比を固定

　　ppShape.Width = Application.CentimetersToPoints(10) '横幅

　　

　　'グラフを画像で貼りつけ

　　ws.ChartObjects(1).Chart.CopyPicture xlScreen, xlPicture

　　'PasteSpeciaでエラーが出るときは、ここに待ちを作ります。

　　ppSlide.Shapes.Paste

　　Set ppShape = ppSlide.Shapes(ppSlide.Shapes.Count) '最後の図形

　　'上の図形の1cm下

　　Dim nextLeft As Single

　　nextLeft = ppSlide.Shapes(ppSlide.Shapes.Count - 1).Left + _

　　　　　　　ppSlide.Shapes(ppSlide.Shapes.Count - 1).Width + _

　　　　　　　Application.CentimetersToPoints(1)

　　ppShape.Top = ppSlide.Shapes(ppSlide.Shapes.Count - 1).Top　'上位置

　　ppShape.Left = nextLeft '左位置

　　ppShape.LockAspectRatio = msoTrue '縦横比を固定

　　ppShape.Width = Application.CentimetersToPoints(10)　'横幅

　　Application.CutCopyMode = False

　　

　　'パワーポイント終了

　　ppPt.Save

　　ppApp.Quit

　　Set ppSlide = Nothing

　　Set ppPt = Nothing

　　Set ppApp = Nothing

End Sub

PowerPointを使う準備と保存終了


  
    
      　　Dim ppApp As New PowerPoint.Application

　　Dim ppPt As Presentation

　　Dim ppSlide As Slide

　　Dim ppShape As PowerPoint.Shape

　　'ppApp.Visible = True 'PowerPoint2007以前の場合は有効にしてください。

　　Set ppPt = ppApp.Presentations.Open(ThisWorkbook.Path & "\sample.pptx")

      　　　　

　　'パワーポイント終了

　　ppPt.Save

　　ppApp.Quit

　　Set ppSlide = Nothing

　　Set ppPt = Nothing

      　　Set ppApp = Nothing

上のVBAでは参照設定をしています。
Microsoft PowerPoint xx.x ObjectLibrary
参照設定をしない場合は、


  
    
       　　Dim ppApp As Object

      　　Set ppApp = CreateObject("PowerPoint.Application")

      　　Dim ppPt As Object

      　　Dim ppSlide As Object

      　　Dim ppShape As Object

また、貼り付け時点の、
ppPasteEnhancedMetafile → 2
このように変更してください。

表（セル範囲）をPowerPointへ貼り付けるVBAの解説


  
    
      　　ws.Range("A1").CurrentRegion.Copy

      　　'PasteSpeciaでエラーが出るときは、ここに待ちを作ります。

      　　ppSlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile, Link:=msoFalse

      　　Set ppShape = ppSlide.Shapes(ppSlide.Shapes.Count) '最後の図形

      　　ppShape.Top = Application.CentimetersToPoints(1) '上位置

      　　ppShape.Left = Application.CentimetersToPoints(1) '左位置

      　　ppShape.LockAspectRatio = msoTrue '縦横比を固定

      　　ppShape.Width = Application.CentimetersToPoints(10) '横幅

ppSlide.Shapes.Count
これは、そのスライドにあるShapesの数になるので、
ppSlide.Shapes(ppSlide.Shapes.Count)
これは、そのスライドの最後に貼り付けた図になります。

PasteSpecialのDataType

DataType	PpPasteDataType	クリップボードの内容をドキュメントに挿入するときの形式です。既定値は、クリップボードの内容によって異なります。クリップボードの内容が引数 DataType で指定したデータ型がサポートされていない場合、エラーが発生します。 DataTypeには以下が指定可能です。 ppPasteBitmap ppPasteDefault ppPasteEnhancedMetafile ppPasteHTML ppPasteGIF ppPasteJPG ppPasteMetafilePicture ppPastePNG ppPasteShape
DisplayAsIcon	MsoTriState	埋め込みオブジェクトまたはリンクをアイコンで表示するには、MsoTrue?を設定します。
IconFileName	文字列型 (String)	引数 DisplayAsIcon が定数?msoTrue?に設定されている場合、この引数は表示するアイコンが保存されているファイルのパスとファイル名となります。引数 DisplayAsIcon が定数?msoFalse?に設定されている場合、この引数は無視されます。
IconIndex	長整数型 (Long)	DisplayAsIcon がmsoTrueに設定されている場合この引数は IconFilename で指定されるプログラムファイルで使用するアイコンに対応する番号です。たとえば、0 (ゼロ) は最初のアイコンに対応して 1、2 番目のアイコンに対応します。この引数を省略すると、最初の (既定の) アイコンが使用されます。 DisplayAsIcon がmsoFalseに設定されている場合、この引数は無視されます。IconIndex が有効な範囲外にある場合は、既定のアイコン (インデックス 0) が使用されます。
IconLabel	文字列型 (String)	引数 DisplayAsIcon が定数?msoTrue?に設定されている場合、この引数はアイコンの下に表示されるテキストとなります。このラベルがない場合、クリップボードの内容に基づいてアイコンラベルが作成されます。引数 DisplayAsIcon が定数?msoFalse?に設定されている場合、この引数は無視されます。
Link	MsoTriState	クリップボード内容のソースファイルへのリンクを作成するかどうかを指定します。クリップボードの内容がリンクをサポートしていない場合、エラーが発生します

Application.CentimetersToPoints

センチメートル単位の数値を、ポイント (1 ポイントは、0.35 mm) 単位に変換します。

Application.InchesToPoints
こちらは、インチ単位の数値をポイント単位に変換します。

ポイント: 印刷する文字のサイズ (高さ) を指定する基本単位。
1ポイントは、約0.0353cm (1/72インチ) です。

グラフをPowerPointへ貼り付けるVBAの解説


  
    
      　　ws.ChartObjects(1).Chart.CopyPicture xlScreen, xlPicture

      　　'PasteSpeciaでエラーが出るときは、ここに待ちを作ります。

      　　ppSlide.Shapes.Paste

      　　Set ppShape = ppSlide.Shapes(ppSlide.Shapes.Count) '最後の図形

      　　'上の図形の1cm右の位置へ移動

      　　Dim nextLeft As Single

      　　nextLeft = ppSlide.Shapes(ppSlide.Shapes.Count - 1).Left + _

      　　　　　　　ppSlide.Shapes(ppSlide.Shapes.Count - 1).Width + _

      　　　　　　　Application.CentimetersToPoints(1)

      　　ppShape.Top = ppSlide.Shapes(ppSlide.Shapes.Count - 1).Top　'上位置

      　　ppShape.Left = nextLeft '左位置

      　　ppShape.LockAspectRatio = msoTrue '縦横比を固定

      　　ppShape.Width = Application.CentimetersToPoints(10)　'横幅

先に貼り付けた表（セル範囲）の右横1cmに配置しています。

Chart.CopyPicture

オブジェクトをクリップボードへピクチャ (画像) としてコピーします。

Chart.CopyPicture(Appearance, Format)

名前	必須 / オプション	データ型	説明
Appearance	省略可能	Variant	画像をコピーする方法を、ピクチャの外観を定数で指定します。既定値はxlScreenです。
Format	省略可能	Variant	図の書式を指定するXlCopyPictureFormat定数を指定します。既定値はxlPictureです。

貼り付け時のエラー対応

Excelの表が大きかったり情報が複雑な場合、PasteSpecialでエラーとなる場合があります。
また、繰り返し何回も貼り付ける場合にもエラーが出やすくなります。
エラーの発生理由は、Copyが非同期で行われているらしいことが原因です。

対策としては、Copyの直後に一定時間待ちを作ることです。
まず試してみるのは、
DoEvents

DoEvents関数は、発生したイベントがOSによって処理されるように、プログラムで占有していた制御をOSに渡します。DoEvents関数構文 DoEvents 説明開かれているフォームの数を返します。開かれているフォームが無ければ0返します。

これで試してみて下さい、これで解決するならこれが一番良いでしょう。。

これでダメなら、
Application.Wait
これで1秒程度の待ちを作って下さい。


  
    
      Application.Wait Now() + TimeSerial(0, 0, 1)

APIのSleepなら、ms単位で調整できます。

・Declare ステートメン・APIの使用例・いろいろなAPIについて

既にパワーポイントを開いている場合

事前に手動でパワーポインを開いていて、そのパワーポイントをエクセルVBAで操作する場合は、
GetObject関数を使います。

・GetObject関数の構文・GetObjectの解説・GetObject関数の使用例・GetObject関数とCreateObject関数の使い分け・CreateObject関数


  
    
      Sub sample()

      　　Dim ppApp As New PowerPoint.Application

      　　Dim ppPt As Presentation

      　　Dim ppSlide As Slide

      　　Dim ppShape As PowerPoint.Shape


      　　On Error Resume Next

      　　Set ppApp = GetObject(, "PowerPoint.Application")

      　　If Err.Number <> 0 Then

      　　　　MsgBox "パワーポイントが起動されていません。"

      　　　　Exit Sub

      　　End If

      　　On Error GoTo 0

      　　Set ppPt = ppApp.ActivePresentation


      　　'以下同様

GetObject(, "PowerPoint.Application")
これは、パワーポイントが起動していない場合は、エラーになりますので、
On Error Resume Nextを入れてErr判定しています。

複数のプレゼンテーションファイルを開いている場合は、
インデックス（数値）または名称で指定します。


  
    
      Set ppPt = ppApp.Presentations(インデックス)


  
    
      Set ppPt = ppApp.Presentations("sample.pptx")

PresentationsコレクションをFor Eachで順次取得出来ます。


  
    
      For Each ppPt In ppApp.Presentations

      　　Debug.Print ppPt.Name

Next

名称の部分一致で処理を分ける場合もあると思います。


  
    
      For Each ppPt In ppApp.Presentations

      　　If ppPt.Name Like "*○○*" Then

      　　　　'特定のプレゼンテーションだけ処理

      　　End If

Next

同じテーマ「マクロVBAサンプル集」の記事

Excel2003(xls)を2007以降(xlsx,xlsm)に変換する（HasVBProject）
ハイパーリンクからファイルのフルパスを取得する
 ボタンに表示されているテキストを取得（Application.Caller）
Excelの表をPowerPointへ図として貼り付け
VBAで表やグラフをPowerPointへ貼り付ける
フォルダ（サブフォルダも全て）削除する、Optionでファイルのみ削除
 Shift_JISのテキストファイルをUTF-8に一括変換
 VBAコードの全プロシージャー・プロパティ一覧を取得
 数式バーの高さを数式の行数で自動設定
 図形オートシェイプ（Shape）の複数選択
 GoogleスプレッドシートをExcelにインポートする

アクセスランキング・・・ランキング一覧を見る

1.最終行の取得（End,Rows.Count）｜VBA入門
2.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
3.変数宣言のDimとデータ型｜VBA入門
4.RangeとCellsの使い方｜VBA入門
5.繰り返し処理（For Next)｜VBA入門
6.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
7.メッセージボックス(MsgBox関数)｜VBA入門
8.セルのクリア（Clear,ClearContents）｜VBA入門
9.条件分岐（Select Case）｜VBA入門
10.ブック・シートの選択（Select,Activate）｜VBA入門

ホーム
マクロVBA応用編
マクロVBAサンプル集
VBAで表やグラフをPowerPointへ貼り付ける

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。

記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。

VBAサンプル集
VBAで表やグラフをPowerPointへ貼り付ける