【VBA】エクセルの表・グラフをパワーポイントに自動で張り付ける

エクセルVBAでよく使うコードの備忘録。エクセルの表やグラフをパワーポイントに自動で張り付けるコード。

スポンサーリンク

事前準備

VBAでパワーポイントを操作するには、参照設定が必要です。VBAのコードエディタから「ツール > 参照設定」と進み、「Microsoft PowerPoint XX.X Object Library」にチェックを入れておきます。

共通コード

説明するコードを簡素化するために使用した変数などの共通部分です。今回のテーマの本質的な部分には関係はありません。コードを使用する際はカッコに囲まれた部分([***])を自分のプログラムに合わせて変更してください。

'--- プレゼンテーションを開く ---'
Dim pptObj As PowerPoint.Application
Dim pptPrs As PowerPoint.Presentation
Set pptObj = CreateObject("PowerPoint.Application")
pptObj.Visible = True
Set pptPrs = pptObj.Presentations.Open("[貼付先パワーポイントファイルへのパス]")
    
'--- 貼付先の指定用の変数 ---'
Dim page As Long
page = [貼付ページ番号]
Dim top As Long
top = [貼付位置(座標)上から]
Dim left As Long
left = [貼付位置(座標)左から]

'--- 貼付元のエクセルワークシート ---'    
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("[ワークシート名]")

'--- 貼付の設定 ---'
Dim scaleFactor As Double
scaleFactor = [拡大縮小率 1:そのまま]

エクセルの表をパワーポイントに張り付ける

既存のパワーポイントファイルを開き、エクセルの表を拡張メタファイルとして貼り付ける。

'--- 表をコピーする ---'
Dim xlTable As range
Set xlTable = ws.range("[貼付範囲]")
xlTable.Copy

'--- 表を貼り付ける ---'
Dim pptSld As PowerPoint.Slide
Set pptSld = pptPrs.Slides(page) '貼付先のページを指定
Call pptSld.Shapes.PasteSpecial(DataType:=ppPasteEnhancedMetafile, Link:=msoFalse)

'--- 調整のため貼り付けたオブジェクトを取得 ---'    
Dim i As Long
i = pptSld.Shapes.Count '要素数を取得(最後が貼り付けたオブジェクト)

'--- 貼付位置の調整 ---'    
pptSld.Shapes(i).top = top
pptSld.Shapes(i).left = left
    
'--- 貼付サイズを調整 ---'
Call pptSld.Shapes(i).ScaleHeight(scaleFactor, msoFalse)
Call pptSld.Shapes(i).ScaleWidth(scaleFactor, msoFalse)

エクセルのグラフをパワーポイントに張り付ける

既存のパワーポイントファイルを開き、エクセルのグラフを貼り付ける。

'--- グラフをコピーする ---'
Dim xlChart As Chart
Set xlChart = ws.ChartObjects([貼付グラフの番号]).Chart
Call xlChart.CopyPicture(xlScreen, xlPicture) 'Chartを指定
    
--- グラフを貼り付ける ---'
Dim pptSld As PowerPoint.Slide
Set pptSld = pptPrs.Slides(page) '貼付先のページを指定
pptSld.Shapes.Paste
    
'--- 調整のため貼り付けたオブジェクトを取得 ---'    
Dim i As Long
i = pptSld.Shapes.Count '要素数を取得(最後が貼り付けたオブジェクト)

'--- 貼付位置の調整 ---'    
pptSld.Shapes(i).top = top
pptSld.Shapes(i).left = left
    
'--- 貼付サイズを調整 ---'
Call pptSld.Shapes(i).ScaleHeight(scaleFactor, msoFalse)
Call pptSld.Shapes(i).ScaleWidth(scaleFactor, msoFalse)