エクセル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)