Excelの表をPowerPointへ図として貼り付け

最終更新日：2015-03-31

Excelの表をPowerPointへ図として貼り付け

PowerPointを作っていると、エクセルの表を挿入したいことが多いです、
単発作業なら手作業で十分ですが、
定期的にやる場合や、数が多いと大変ですので、マクロで自動化したくなります。

Sub sample()
　　Dim ppApp As New PowerPoint.Application
　　Dim ppPt As Presentation
　　Dim ppSlide As Slide
　　Dim ppShape As PowerPoint.Shape
　　Dim ws As Worksheet
　　'ppApp.Visible = True 'PowerPoint2007以前の場合は有効にしてください。
　　Set ppPt = ppApp.Presentations.Open(ThisWorkbook.Path & "\sample.pptx")
　　Set ws = ThisWorkbook.Worksheets("Sheet1")
　　With ws
　　　　.Range("A1").CurrentRegion.Copy
　　　　'PasteSpeciaでエラーが出るときは、ここに待ちを作ります。
　　　　'スライド番号を指定
　　　　Set ppSlide = ppPt.Slides(1)
　　　　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(30)
　　　　Application.CutCopyMode = False
　　End With
　　
　　ppPt.Save
　　ppApp.Quit
　　Set ppPt = Nothing
　　Set ppApp = Nothing
End Sub

上記は、まずは最低限のコードです。
セル範囲をコピーして、拡張メタファイルとして貼り付けています。
エラー処理は入れていませんので、適宜入れて下さい。
良く発生するエラーについては、下で説明を書きました。

PasteSpecial
この部分の指定は、

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	クリップボード内容のソースファイルへのリンクを作成するかどうかを指定します。クリップボードの内容がリンクをサポートしていない場合、エラーが発生します

ほとんどの場合、上記のコードで問題ないのですが、
Excelの表が大きかったり、情報が複雑な場合、
PasteSpecialでエラーとなる場合があります。
エラーの発生理由は、
Copyが非同期で行われているらしいことが原因です。
そこで、対策としては、Copyの直後に一定時間待ちを作ることです。
まず最初には、
DoEvents
これで試してみて下さい、これで解決するならこれが一番です。
これでダメなら、
Application.Wait
で1秒程度の待ちを作って下さい。
APIのSleepなら、ms単位で調整できます。

実際のプログラムでは、この貼り付けが複数になり、
かつ、サイズ等もそれぞれ指定する必要がありますので、
結構複雑なコードを書くことになります。
このような貼り付け情報を別シートに表にしておき、
それを基に貼り付けるようにする必要があります。