Excelで作成したグラフ等を自動でPowerPointへ貼り付けるExcelVBA

Excelで作成したグラフ等を自動でPowerPointへ貼り付けるExcelVBA

Excelで表のテンプレートだけ作成しておけば、中の数値を変えるだけでグラフに反映出来て良いのですが、定期的にそれを使ったプレゼンテーションを行いたいということ、あると思います。グラフ作成はもちろんExcel、でも発表はPowerPoint。そんな時に作ったプログラムです。


手作業によるコピペから脱却したかった

引き継いで間もないころは、先輩に教わった通りに素直にコピペしてました。前回のpptファイルをコピーして、中身のグラフを消して、新しいグラフを作成して、10個以上あるそれをひとつずつ貼り付けて…。2回くらいやったあたりでうんざりしてきました。

  • ペーストしたときにレイアウトが崩れる
  • ひとつひとつ、大きさを調整しなきゃいけない
  • Excelのデータを含んでいるので、ファイルが重くなる

PowerPoint上で再編集するなら別ですが、Excelの元データはあるんだし、発表するために貼り付けるだけなので画像形式で貼り付けちゃってもいいんじゃないかと。

ExcelVBAのほうが得意だったので、Excelのほうにグラフだけでなく発表用のテキストなんかも全部ひっくるめたテンプレートを作っちゃって、最後にボタンワンクリックでばーっとPowerPointへコピーしちゃえばいいじゃん!という発想に辿り着きました。

Excelでテンプレートを作成

例ですが、こんな感じにしてみます。

120213-1

今回はセルのB2:Q29の範囲を1枚のスライドの大きさにします。(もちろん範囲は変えられます)グラフの大きさの兼ね合いなんかも考慮して、最終的に横:縦=4:3になるように調整します。(だいたいで大丈夫です!)

蛇足ですが、この図のようなグラデーションの棒グラフの作り方(Excel2003)をまとめた記事も書きました。よろしければー。
120213-2

Excelのシート数=PowerPointのスライド数になります。全てのシートでB2:Q29が印刷範囲になりますので注意してください。セルの幅や高さは変えても大丈夫です。見た目の問題で私はセルの大きさを変えても全体的には同じ大きさになるように調整していますが、気にしなくても問題ありません。でもだいたい4:3にしておくと吉。(仕上がりで引き伸ばされてしまうので)

追記:PowerPoint2013からデフォルトで16:9になってるので、そちらを使ってる人はこの比率で。(デフォルト16:9のバージョンを4:3で起動したい場合のコードはコメント欄をご参照ください。)

コード

Sub CopyToPPT()
  Dim ppApp As Object 'PowerPointアプリ
  Dim ppPst As Object 'PowerPointプレゼン
  Dim ppSld As Object 'PowerPointスライド
  Dim ppW As Single, ppH As Single, i As Integer

  On Error Resume Next
  'PowerPointを起動
  Set ppApp = CreateObject("PowerPoint.Application")
  If ppApp Is Nothing Then
    On Error GoTo ERROR_HANDLER
    Err.Raise 1000, , "PowerPoint の起動に失敗しました"
  End If

  On Error GoTo ERROR_HANDLER

  'PowerPointを表示
  ppApp.Visible = msoTrue
  'PowerPoint新規プレゼンテーション作成
  Set ppPst = ppApp.Presentations.Add(WithWindow:=True)
  'PowerPoint画面最大サイズを取得
  With ppPst.PageSetup
    ppH = .SlideHeight
    ppW = .SlideWidth
  End With

  'Excel各シートの貼り付け
  For i = 1 To ThisWorkbook.Worksheets.Count
    '指定範囲をクリップボードにコピー
    ThisWorkbook.Worksheets(i).Range("B2:Q29").CopyPicture xlScreen, xlPicture
    'PowerPointスライド追加
    Set ppSld = ppPst.Slides.Add(Index:=i, Layout:=12)
    '貼り付け
    ppSld.Shapes.Paste
    'PowerPointグラフ位置・サイズを最大になるように補正
    With ppSld.Shapes(1)
      .LockAspectRatio = msoFalse
      .Top = 0
      .Left = 0
      .Height = ppH
      .Width = ppW
    End With
  Next i

  'PowerPointを保存
  ppApp.ActivePresentation.SaveAs Filename:=ThisWorkbook.Path & "/" & Replace(ActiveWorkbook.Name, ".xls", ".ppt")

TERMINATE:
  On Error GoTo 0
  Set ppApp = Nothing
  Set ppPst = Nothing
  Set ppSld = Nothing
  Exit Sub

ERROR_HANDLER:
  MsgBox Err.Description, vbCritical
  Resume TERMINATE
End Sub

※2007以降のバージョンは、46行目を .xlsm と .pptx にしてください。

こいつをコピペして、1P目のボタンから起動できるように設定します。こちらを参考にどうぞ。セル範囲は30行目でお好みに設定してください。(Office2007以降の場合、46行目の保存するところは「.xlsm」と「.pptx」にしてください。)

起動してみるとこんな感じ

120213-3

全てのシートのB2:Q29セルがコピペされ、Excelのファイル名と同じ名前で、同じフォルダに保存されます。シート数はもっと多くても問題ありません。

グラフを画像として貼り付けているので再編集はできませんが、私の環境だと従来の1/4くらいの容量になりました。

2012/6/25追記

既存pptにスライドを1枚追加してコピペするコード

コメント欄で質問を頂いたので作ってみました。開いているプレゼンテーションに、エクセルのアクティブシート1枚のみをスライド追加してコピペするコードです。パワーポイントが起動している状態でご使用ください。

Sub add_CopyToPPT()
  Dim ppApp As Object 'PowerPointアプリ
  Dim ppPst As Object 'PowerPointプレゼン
  Dim ppSld As Object 'PowerPointスライド
  Dim ppW As Single, ppH As Single, i As Integer

  On Error GoTo ERROR_HANDLER

  Set ppApp = CreateObject("PowerPoint.Application")
  Set ppPst = ppApp.ActivePresentation
  'PowerPoint画面最大サイズを取得
  With ppPst.PageSetup
    ppH = .SlideHeight
    ppW = .SlideWidth
  End With

  '指定範囲をクリップボードにコピー
  ActiveSheet.Range("B2:Q29").CopyPicture xlScreen, xlPicture
  'PowerPointスライド数取得
  i = ppPst.Slides.Count
  'PowerPointスライド追加
  Set ppSld = ppPst.Slides.Add(Index:=i + 1, Layout:=12)
  '貼り付け
  ppSld.Shapes.Paste
  'PowerPointグラフ位置・サイズを最大になるように補正
  With ppSld.Shapes(1)
    .LockAspectRatio = msoFalse
    .Top = 0
    .Left = 0
    .Height = ppH
    .Width = ppW
  End With

TERMINATE:
  On Error GoTo 0
  Set ppApp = Nothing
  Set ppPst = Nothing
  Set ppSld = Nothing
  Exit Sub

ERROR_HANDLER:
  MsgBox Err.Description, vbCritical
  Resume TERMINATE
End Sub

コピペしたいシートだけ選べるので、こちらのほうが自由度が高いかもしれませんね。18行目の指定範囲Range("B2:Q29")はお好きに改変してください。

2019/3/15追記

既存pptにExcelシート数ぶんスライドを追加&コピペするコード

さらにコメント欄で質問を頂いたので作ってみました。開いているプレゼンテーションに、スライド追加しながらエクセルの全シートをコピペするコードです。パワーポイントが起動している状態でご使用ください。

Sub add_CopyToPPT()
  Dim ppApp As Object 'PowerPointアプリ
  Dim ppPst As Object 'PowerPointプレゼン
  Dim ppSld As Object 'PowerPointスライド
  Dim ppW As Single, ppH As Single, i As Integer
 
  On Error GoTo ERROR_HANDLER
 
  Set ppApp = CreateObject("PowerPoint.Application")
  Set ppPst = ppApp.ActivePresentation
  'PowerPoint画面最大サイズを取得
  With ppPst.PageSetup
    ppH = .SlideHeight
    ppW = .SlideWidth
  End With
  
  'Excel各シートを追加で貼り付け
  For i = 1 To ThisWorkbook.Worksheets.Count
    '指定範囲をクリップボードにコピー
    ThisWorkbook.Worksheets(i).Range("B2:Q29").CopyPicture xlScreen, xlPicture
    'PowerPointスライド追加
    Set ppSld = ppPst.Slides.Add(Index:=ppPst.Slides.Count + 1, Layout:=12)
    '貼り付け
    ppSld.Shapes.Paste
    'PowerPointグラフ位置・サイズを最大になるように補正
    With ppSld.Shapes(1)
      .LockAspectRatio = msoFalse
      .Top = 0
      .Left = 0
      .Height = ppH
      .Width = ppW
    End With
  Next i
 
TERMINATE:
  On Error GoTo 0
  Set ppApp = Nothing
  Set ppPst = Nothing
  Set ppSld = Nothing
  Exit Sub
 
ERROR_HANDLER:
  MsgBox Err.Description, vbCritical
  Resume TERMINATE
End Sub

基本的には上のコードにループを追加しただけです!

更に追記

コメント欄で頂いた質問について、新たに記事を書きました。こちらも宜しければどうぞ。

公開日:2012/02/13
更新日:2019/03/15

37件のコメント

  1. あおい より:

    はじめまして!
    毎月同じテンプレのエクセルグラフをパワポに張り付ける作業をしていて、なんとか効率化できないか検索していたところ、こちらのページにたどり着きました。
    超簡単なマクロしかいじったことのない私でもなんとかなりました~。感動です!!

    厚かましくも質問です。ご経験から、もしお分かりになりましたら教えてください。
    上記のVBAを実行すると、処理は正常に終わるにも関わらず、グラフ上のテキストボックスが一部コピーされずに、空白になってしまう時があります。1枚のグラフに30個近くのテキストボックスを利用していて、後半(グラフの下方1/6くらい)で発生しやすいようです。回避方法が分かれば教えていただけますでしょうか。

    環境は、エクセル、パワポとも2003を使用しています。

    <関係ないかもしれませんが・・・補足>
    ・エクセルのシートは20枚ほどで、そのうちグラフ用に使用しているシートは左から3枚目まで。(残りの17枚はパワポシートを削除してます)
    ・2枚目、3枚目のシートで同じ現象が出ています。
    1枚目のシートはテキストボックスの使用がほとんどなく、2枚目、3枚目はテキストボックスが多いです。

    ps
    こちらのエントリーに触発されて、「EXCEL VBAのプログラミングのツボとコツがゼッタイに分かる本」買っちゃいまいた。楽しいです♪

    • you より:

      あおいさん、初めまして。

      お役に立ててとっても嬉しいです!
      上記の件、私の環境(xls,ppt共に2003)でも試してみたところ、同じことが起こりました。テキストボックスはこういうところ不安定ですね。。
      どうやら「グラフ内」のテキストボックスは下部が消えたりするようですが、「グラフ外」に作成したテキストボックスをグラフに重ねるぶんには正常に貼り付けられるようですので、試してみて下さい。

      あと、貼り付けるシートが3枚目までで良いのなら、28行目のThisWorkbook.Worksheets.Count3にすると、いらないシート削除の手間が省けると思います。

      ExcelVBAにハマるきっかけにして頂いて光栄です!仕事効率化って、やってみると楽しいですよね。頑張ってください☆

  2. yoyo より:

    とても素晴らしいアイディアです。
    一つの質問させていただきます。
    このVBAでは、現在のシートのグラフや文書をPPTに貼り付けです。しかし、グラフを更新して、新たなスライドに追加したいときは、別のPPTを作ることとなりますね。
    もし可能であれば、データを更新しながら、グラフを更新して、そして新なスライドに追加していくことが可能でしょうか。
    教えてください。

    • you より:

      yoyoさんコメントありがとうございます!
      記事に追記してみたんですが、これでご要望のことはできますでしょうか?

    • yoyo より:

      you様
      わざわざ作っていただき、ありがとうございました。
      とても役に立ちました。
      自分はVBAの初心者で、これからも少しずつ勉強していきます。よろしくお願いいたします。
      再度、ありがとうございました。

    • you より:

      お役に立てて良かったです!見当違いだったらどうしようかとドキドキしてました(笑)VBA、ハマると面白いと思うので、是非頑張ってくださいね。

  3. あーさん より:

    すごいです!
    活用させていただきます。
    これでコピペ生活から開放されます。

    • you より:

      あーさん さん、コメントありがとうございます。
      グラフのコピペ面倒ですよねー、お役に立てて嬉しいです!

  4. ニッツ より:

    こんにちは。
    現在毎日日報を作成しており、Excelのグラフを既存のPPTに貼り付けて更新する作業をしています。
    既存のPPTには、図形や題名やコメントなどが貼り付けられており、それらを残してグラフだけを削除し、新しいグラフを決められたExcelシートからそれぞれ貼り付ける、という作業をしているのですが、こちらも自動的にすること可能でしょうか?
    できれば貼り付けたグラフは最背面に持っていき、コメントや図形を前面に出したいのですが。。。
    こんなにわがままな設定まで無理だとは思いますが、出来る範囲でもし分かれば教えて頂きたいと思います。

  5. ニッツ より:

    先ほどのコメントで追記です。
    現在exelもpptも2003を使用しており、PPTに貼り付ける時の形式は図(拡張メタファイル)を指定して貼り付けをしています。

    • you より:

      ニッツさん、コメントありがとうございます。
      作ってみていますが、ちょっと説明が長くなりそうなので新しい記事として解説させて頂きたいと思っています。少々お待ちくださいませ。

      追記:こちらに書きました!

  6. マック より:

    エクセルを中心にVBAは結構使ってきましたが、パワーポイントVBAは殆ど手を付けたことがありませんでした。

    ところが今回はエクセルでデータ処理をするVBAを作り、その出力結果のグラフをパワーポイントのスライドとして追加する事を思いついたのですが、このページの例をベースに(というかほとんどそのままで)簡単に実現することができました。

    エクセルと違って作業をVBAとして記録することができないので、パワーポイントのVBAはどうも敷居が高いですね。

    本当に助かりました。どうもありがとうございました。

    • you より:

      マックさん、はじめまして。
      私もPowerPointのVBAはよくわからなくて、Excelからどうにかできないかと試行錯誤しました。。お役に立ててとても嬉しいです。コメントありがとうございました!

  7. マック より:

    さてちょっと欲が出まして、自動で作ったスライドにタイトルを
    付けたいと思いました。アウトラインモードで一番上のレベルに
    出る文字です。

    以下でうまく行きましたのでご報告。

    1.22行を Layout := 11に変更 (タイトル付き)
    2.26行を with ppSld.Shapes(2)に変更(タイトルが1つ目のShapeになる為)
    3.33行目でタイトルを設定
      ppSld.Shapes.Title.TextFrame.TextRange.Text = “タイトル”

    でもこういうのをぱっと自動記録で出来ないのが敷居の高さですよねえ。

    • you より:

      マックさん、ありがとうございますー!
      改良して使ってもらえるっていうのも嬉しいものですね(*´∀`*) ご紹介ありがとうございました!

  8. マロン より:

    you様

     こんにちは、はじめまして。
     エクセルのシートをパワーポイントに自動で貼り付ける方法凄いです。
    一番上に記載されているコードをそのまま使用させていただいているのですが、一つのファイルを複数台のPCで試した時、pptに貼り付いた時に横幅がはみ出るPCとはみでないPCがあって困っています。どうしても原因が分からないので教えて頂けないでしょうか?
    【OS】windows xp
    【office】 2003を使用しています。

  9. ひーひー より:

    はじめまして!
    自分でも、こんなことやりたいなーと思ってたところに、どんぴしゃりのサイトに巡り合えて、ハッピーです!
    ひとつ質問させていただきたいのですが、自分の場合、エクセルで作った「表」を、マクロを使って、パワポに大量生産で貼っていきたいのですが、その際、パワポ上でペーストした表の修正・加工ができるよう、パワポの貼り付けオプションにある「元の書式を保持」した形で、ペーストしたいのですが、うまくいきません。
    「図(画像)としてペースト」や、「そのままただペースト(その場合、背景色がついてしまったり、列幅など崩れる)」なら分かるのですが、それだと見栄え的に致命傷なので、なにかいい方法があれば、なにとぞご教授くださいませ。

    • *you より:

      ひーひーさん、はじめまして。

      PowerPoint側での貼付時のデータタイプを指定してやればいいんじゃないのかな、と思うのですが、いくつかある形式のうち「元の書式を保持」がどれにあたるのかがイマイチ特定できずにいます(;´Д`)

      ご期待に添える結果が出るか分かりませんが、検証した結果を新たに記事にする予定でいますので、もうしばらくお時間頂けますでしょうか。

      追記:こちらに書きました!

  10. やまだのこ より:

    こんばんは、はじめまして。
    大量のエクセル画像をパワーポイントに貼り付ける必要がでてきたところにこのサイトに出会えて大変助かります。本当に素晴らしい。ほぼこのままのコードで目的が叶ってしまったのですが、1点、スライドサイズを従来の4:3に指定するにはどうしたらよいか教えて頂けませんでしょうか….。
    >追記:PowerPoint2013からデフォルトで16:9になってるので、そちらを使ってる人はこの比率で。

    • *you より:

      やまだのこ さん、コメントありがとうございます。コピペ作業のうんざり加減、本当によくわかります、お役に立ててなによりです。4:3で起動するには、新規ファイルを作成するコードのところに下記のように追記してください。

      'PowerPoint新規プレゼンテーション作成
      Set ppPst = ppApp.Presentations.Add
      ppPst.PageSetup.SlideSize = 1 '定数1 = ppSlideSizeOnScreen
      

      なお、本文中では2行目の部分が ppApp.Presentations.Add(WithWindow:=True) と書いてありますが、カッコの中は既定値で True なので書かなくても大丈夫です。

  11. やまだのこ より:

    *youさん、お忙しいところ早速のご対応有難うございます!
    わーん、うれしい・・・ (T T) (T T)

  12. にん より:

    こんにちは。大変参考にさせて頂いております。パワーポイント(2017)側に本VBAをエクセル(2017)にボタンにて配置して実行すると、横に引き延ばされてしまいます。
    パワーポイントのシートには綺麗にA4サイズとしぴったりと全体は入っています。
    でも横側に伸びた字やオートシェイプになってしまいます。どの辺をいじればメタファイルで貼り付けたような均等になりますでしょうか?

    • *you より:

      にんさん、コメントありがとうございます。スライドと同じ大きさに引き伸ばされる処理は、以下の部分です。

      'PowerPointグラフ位置・サイズを最大になるように補正
      With ppSld.Shapes(1)
        .LockAspectRatio = msoFalse '縦横比固定を解除
        .Top = 0 '上からの位置
        .Left = 0 '左からの位置
        .Height = ppH '高さをスライドの大きさと同じにする
        .Width = ppW '横幅をスライドの大きさと同じにする
      End With
      

      貼り付け先はA4横のようですので、上記を以下のように直すと良いと思います。縦横比はデフォルトで固定なので、解除しない場合は書かなくて大丈夫です。

      '貼り付けた図を縦横比固定で縦最大に補正
      With ppSld.Shapes(1)
        .Top = 0 '上からの位置
        .Left = 0 '左からの位置
        .Height = ppH '高さをスライドの大きさと同じにする
      End With
      

      縦横比固定したまま高さだけスライドに合わせれば不自然に引き伸ばされないと思います。お試しください。

  13. にん より:

    早速のご連絡ありがとうございます。
    助かりましたぁ〜
    神様みたいです!

  14. Mash より:

    はじめまして。定期的に200ページ程のレポート作成があり、今回からはコピペ手作業をやめたい!と思い、参考にさせて頂いております。ありがとうございます。
    ペーストする際、「新規プレゼンテーション作成」もしくは「スライド追加」の方法を教えていただいたのですが、すでにページネーションされているパワポ資料があり、指定したスライドにグラフを貼りたい(例:スライドP41~50まで、10シートのグラフ(グラフを含んだ範囲のセルを選択しコピー)をそれぞれ貼り付けたい)という場合、スライドを指定してグラフを貼りつけることは可能でしょうか・・?初心者ゆえ、実現可能かどうかわからず、恐れ入りますがご教示頂けますと幸いです。よろしくお願いいたします!

  15. Mash より:

    *youさん、早急にご返信頂きありがとうございます。
    教えて頂いた記事で試してみたところ、解決いたしました!ありがとうございました!

    • *you より:

      こちらこそご報告ありがとうございます! お役に立てまして光栄です(*´∀`)

  16. 中城孝浩 より:

    はじめまして。
    エクセルの表を張り付ける作業を毎週実施する予定の中
    手作業から脱却したく検索したら本サイトに行きつきました。
    本当に目から鱗でこんなことできるのかと大変助かっております。

    作成している中で是非アドバイス頂きた事がありご質問させていただきます。

    既存のパワーポイントのスライド(たとえば10ページ作成)に追加でこのVBAを利用して
    複数枚のスライドをのエクセルのシートコピーで追加させるためにはどうしたらいいのでしょうか?
    今現在いい感じで新規パワーポイントファイルとしてエクセルの表をコピーしスライド作成(計6ページ)のVBAは動かせています。ご教示頂けると助かります。

    一枚追加のプログラムは拝見したのですが、今の複数枚のプログラムに何かコードを追加して
    既存(開いているパワーポイントファイルのスライド末から)ファイルに追加が出来ると
    うれしいです。できたスライドコピーすればいいんですが・・・ここまでくるとやりたくて。。

    • *you より:

      中城さん、コメントありがとうございます。

      もう7年も前に書いた記事に未だに需要があって嬉しい限りです。「ここまでくるとやりたくて」という気持ちこそプログラミング上達の一歩だと思います! 記事の最後のほうに追記しましたのでご参照ください。

    • 中城孝浩 より:

      *youさん
      早速のご返信並びにコードまでありがとうございます!!
      また、ご返信遅くなり大変申し訳ありません。まさかこんなレスポンスが早いとは
      思ってもみませんでした・・。感謝感謝でございます!
      早速利用してみて、無事こちらが望んでいる動きをしてくれました!
      ありがとうございました!

    • *you より:

      中城さん、こちらこそお返事遅れてすみません~! お望みの動きになったようでなによりです!

  17. まさひろ より:

    はじめまして。
    Excelマクロ入門者です。
    社内ヘルプデスク業務をしています。
    パワーポイントの自動化を探していたらこちらのHPに辿り着きました。

    毎月、対応件数と詳細をExcelの表に記録しております。翌月月初にパワーポイントのスライドへ、Excelの表の形式を変えずに貼り付けて、上司へ報告しています。

    見出し列は変更ありませんが、縦の件数については月々によって件数が変わります。

    毎回、スライドへコピペしているのですが、貼り付け位置などがズレてしまいます。

    ネット検索するとパワーポイントへグラフを自動貼り付けの解説は見つかるのですが、Excelの表を貼り付けて、サイズを整えるなどの自動化のHPは見つかりませんでした。

    Excelの表を図形形式やExcelのリンク形式ではなく、貼り付けたい後にフォントの変更も出来るように「元の書式を残して貼り付け」たいです。

    (イメージとしては、※youさんのグラフの元となるExcelの表をスライドに貼り付ける感じです)

    どのようにマクロを作れば良いのかわかりません。教えてください。

    よろしくお願いいたします。


コメントを残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください

コメントは承認制ですので、反映までしばらくお待ち下さい。(稀にスパムの誤判定にて届かないこともあるようですので、必要な際はお問い合わせからお願い致します。)

YouTubeでQ&Aコンテンツを企画しています

運営しているYouTubeチャンネルで、ご相談やご質問を募集しています。動画のコメントやお問い合わせページからお気軽にご相談をお寄せください。