Excelで作成したグラフ等を自動でPowerPointへ貼り付けるExcelVBA
Excelで表のテンプレートだけ作成しておけば、中の数値を変えるだけでグラフに反映出来て良いのですが、定期的にそれを使ったプレゼンテーションを行いたいということ、あると思います。グラフ作成はもちろんExcel、でも発表はPowerPoint。そんな時に作ったプログラムです。
手作業によるコピペから脱却したかった
引き継いで間もないころは、先輩に教わった通りに素直にコピペしてました。前回のpptファイルをコピーして、中身のグラフを消して、新しいグラフを作成して、10個以上あるそれをひとつずつ貼り付けて…。2回くらいやったあたりでうんざりしてきました。
- ペーストしたときにレイアウトが崩れる
- ひとつひとつ、大きさを調整しなきゃいけない
- Excelのデータを含んでいるので、ファイルが重くなる
PowerPoint上で再編集するなら別ですが、Excelの元データはあるんだし、発表するために貼り付けるだけなので画像形式で貼り付けちゃってもいいんじゃないかと。
ExcelVBAのほうが得意だったので、Excelのほうにグラフだけでなく発表用のテキストなんかも全部ひっくるめたテンプレートを作っちゃって、最後にボタンワンクリックでばーっとPowerPointへコピーしちゃえばいいじゃん!という発想に辿り着きました。
Excelでテンプレートを作成
例ですが、こんな感じにしてみます。
今回はセルのB2:Q29
の範囲を1枚のスライドの大きさにします。(もちろん範囲は変えられます)グラフの大きさの兼ね合いなんかも考慮して、最終的に横:縦=4:3
になるように調整します。(だいたいで大丈夫です!)
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」にしてください。)
起動してみるとこんな感じ
全てのシートの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
基本的には上のコードにループを追加しただけです!
更に追記
コメント欄で頂いた質問について、新たに記事を書きました。こちらも宜しければどうぞ。
ExcelVBAに興味をお持ちの方は、こちらの記事もどうぞ!
- これからExcelのマクロを始めたいという方に!簡単な練習問題作りました。
- 私がExcelVBAでよく使う便利なコード・スニペットまとめ
- プログラム初心者さんへ贈る、エラーが起きたら試してみて欲しいこと
- ExcelVBAのクラスモジュールって何?という人向けの使い方まとめ
書籍を執筆しています。
37件のコメント
はじめまして!
毎月同じテンプレのエクセルグラフをパワポに張り付ける作業をしていて、なんとか効率化できないか検索していたところ、こちらのページにたどり着きました。
超簡単なマクロしかいじったことのない私でもなんとかなりました~。感動です!!
厚かましくも質問です。ご経験から、もしお分かりになりましたら教えてください。
上記のVBAを実行すると、処理は正常に終わるにも関わらず、グラフ上のテキストボックスが一部コピーされずに、空白になってしまう時があります。1枚のグラフに30個近くのテキストボックスを利用していて、後半(グラフの下方1/6くらい)で発生しやすいようです。回避方法が分かれば教えていただけますでしょうか。
環境は、エクセル、パワポとも2003を使用しています。
<関係ないかもしれませんが・・・補足>
・エクセルのシートは20枚ほどで、そのうちグラフ用に使用しているシートは左から3枚目まで。(残りの17枚はパワポシートを削除してます)
・2枚目、3枚目のシートで同じ現象が出ています。
1枚目のシートはテキストボックスの使用がほとんどなく、2枚目、3枚目はテキストボックスが多いです。
ps
こちらのエントリーに触発されて、「EXCEL VBAのプログラミングのツボとコツがゼッタイに分かる本」買っちゃいまいた。楽しいです♪
あおいさん、初めまして。
お役に立ててとっても嬉しいです!
上記の件、私の環境(xls,ppt共に2003)でも試してみたところ、同じことが起こりました。テキストボックスはこういうところ不安定ですね。。
どうやら「グラフ内」のテキストボックスは下部が消えたりするようですが、「グラフ外」に作成したテキストボックスをグラフに重ねるぶんには正常に貼り付けられるようですので、試してみて下さい。
あと、貼り付けるシートが3枚目までで良いのなら、28行目の
ThisWorkbook.Worksheets.Count
を3
にすると、いらないシート削除の手間が省けると思います。ExcelVBAにハマるきっかけにして頂いて光栄です!仕事効率化って、やってみると楽しいですよね。頑張ってください☆
とても素晴らしいアイディアです。
一つの質問させていただきます。
このVBAでは、現在のシートのグラフや文書をPPTに貼り付けです。しかし、グラフを更新して、新たなスライドに追加したいときは、別のPPTを作ることとなりますね。
もし可能であれば、データを更新しながら、グラフを更新して、そして新なスライドに追加していくことが可能でしょうか。
教えてください。
yoyoさんコメントありがとうございます!
記事に追記してみたんですが、これでご要望のことはできますでしょうか?
you様
わざわざ作っていただき、ありがとうございました。
とても役に立ちました。
自分はVBAの初心者で、これからも少しずつ勉強していきます。よろしくお願いいたします。
再度、ありがとうございました。
お役に立てて良かったです!見当違いだったらどうしようかとドキドキしてました(笑)VBA、ハマると面白いと思うので、是非頑張ってくださいね。
すごいです!
活用させていただきます。
これでコピペ生活から開放されます。
あーさん さん、コメントありがとうございます。
グラフのコピペ面倒ですよねー、お役に立てて嬉しいです!
こんにちは。
現在毎日日報を作成しており、Excelのグラフを既存のPPTに貼り付けて更新する作業をしています。
既存のPPTには、図形や題名やコメントなどが貼り付けられており、それらを残してグラフだけを削除し、新しいグラフを決められたExcelシートからそれぞれ貼り付ける、という作業をしているのですが、こちらも自動的にすること可能でしょうか?
できれば貼り付けたグラフは最背面に持っていき、コメントや図形を前面に出したいのですが。。。
こんなにわがままな設定まで無理だとは思いますが、出来る範囲でもし分かれば教えて頂きたいと思います。
先ほどのコメントで追記です。
現在exelもpptも2003を使用しており、PPTに貼り付ける時の形式は図(拡張メタファイル)を指定して貼り付けをしています。
ニッツさん、コメントありがとうございます。
作ってみていますが、ちょっと説明が長くなりそうなので新しい記事として解説させて頂きたいと思っています。少々お待ちくださいませ。
追記:こちらに書きました!
エクセルを中心にVBAは結構使ってきましたが、パワーポイントVBAは殆ど手を付けたことがありませんでした。
ところが今回はエクセルでデータ処理をするVBAを作り、その出力結果のグラフをパワーポイントのスライドとして追加する事を思いついたのですが、このページの例をベースに(というかほとんどそのままで)簡単に実現することができました。
エクセルと違って作業をVBAとして記録することができないので、パワーポイントのVBAはどうも敷居が高いですね。
本当に助かりました。どうもありがとうございました。
マックさん、はじめまして。
私もPowerPointのVBAはよくわからなくて、Excelからどうにかできないかと試行錯誤しました。。お役に立ててとても嬉しいです。コメントありがとうございました!
さてちょっと欲が出まして、自動で作ったスライドにタイトルを
付けたいと思いました。アウトラインモードで一番上のレベルに
出る文字です。
以下でうまく行きましたのでご報告。
1.22行を Layout := 11に変更 (タイトル付き)
2.26行を with ppSld.Shapes(2)に変更(タイトルが1つ目のShapeになる為)
3.33行目でタイトルを設定
ppSld.Shapes.Title.TextFrame.TextRange.Text = “タイトル”
でもこういうのをぱっと自動記録で出来ないのが敷居の高さですよねえ。
マックさん、ありがとうございますー!
改良して使ってもらえるっていうのも嬉しいものですね(*´∀`*) ご紹介ありがとうございました!
you様
こんにちは、はじめまして。
エクセルのシートをパワーポイントに自動で貼り付ける方法凄いです。
一番上に記載されているコードをそのまま使用させていただいているのですが、一つのファイルを複数台のPCで試した時、pptに貼り付いた時に横幅がはみ出るPCとはみでないPCがあって困っています。どうしても原因が分からないので教えて頂けないでしょうか?
【OS】windows xp
【office】 2003を使用しています。
マロンさん、コメントありがとうございます。出来る限りの環境で試してみたのですが、残念ながら再現することができませんでした。
こちらにあるように、PCの問題である可能性が高いかもしれません。(もしかして、ご本人様の質問でしょうか。)お力になれず、申し訳ありません。
はじめまして!
自分でも、こんなことやりたいなーと思ってたところに、どんぴしゃりのサイトに巡り合えて、ハッピーです!
ひとつ質問させていただきたいのですが、自分の場合、エクセルで作った「表」を、マクロを使って、パワポに大量生産で貼っていきたいのですが、その際、パワポ上でペーストした表の修正・加工ができるよう、パワポの貼り付けオプションにある「元の書式を保持」した形で、ペーストしたいのですが、うまくいきません。
「図(画像)としてペースト」や、「そのままただペースト(その場合、背景色がついてしまったり、列幅など崩れる)」なら分かるのですが、それだと見栄え的に致命傷なので、なにかいい方法があれば、なにとぞご教授くださいませ。
ひーひーさん、はじめまして。
PowerPoint側での貼付時のデータタイプを指定してやればいいんじゃないのかな、と思うのですが、いくつかある形式のうち「元の書式を保持」がどれにあたるのかがイマイチ特定できずにいます(;´Д`)
ご期待に添える結果が出るか分かりませんが、検証した結果を新たに記事にする予定でいますので、もうしばらくお時間頂けますでしょうか。
追記:こちらに書きました!
こんばんは、はじめまして。
大量のエクセル画像をパワーポイントに貼り付ける必要がでてきたところにこのサイトに出会えて大変助かります。本当に素晴らしい。ほぼこのままのコードで目的が叶ってしまったのですが、1点、スライドサイズを従来の4:3に指定するにはどうしたらよいか教えて頂けませんでしょうか….。
>追記:PowerPoint2013からデフォルトで16:9になってるので、そちらを使ってる人はこの比率で。
やまだのこ さん、コメントありがとうございます。コピペ作業のうんざり加減、本当によくわかります、お役に立ててなによりです。4:3で起動するには、新規ファイルを作成するコードのところに下記のように追記してください。
なお、本文中では2行目の部分が ppApp.Presentations.Add(WithWindow:=True) と書いてありますが、カッコの中は既定値で True なので書かなくても大丈夫です。
*youさん、お忙しいところ早速のご対応有難うございます!
わーん、うれしい・・・ (T T) (T T)
いえいえー! ヾ(*・ω・)人(・ω・*)ノ
こんにちは。大変参考にさせて頂いております。パワーポイント(2017)側に本VBAをエクセル(2017)にボタンにて配置して実行すると、横に引き延ばされてしまいます。
パワーポイントのシートには綺麗にA4サイズとしぴったりと全体は入っています。
でも横側に伸びた字やオートシェイプになってしまいます。どの辺をいじればメタファイルで貼り付けたような均等になりますでしょうか?
にんさん、コメントありがとうございます。スライドと同じ大きさに引き伸ばされる処理は、以下の部分です。
貼り付け先はA4横のようですので、上記を以下のように直すと良いと思います。縦横比はデフォルトで固定なので、解除しない場合は書かなくて大丈夫です。
縦横比固定したまま高さだけスライドに合わせれば不自然に引き伸ばされないと思います。お試しください。
早速のご連絡ありがとうございます。
助かりましたぁ〜
神様みたいです!
滅相もありません、解決してよかったです~!
はじめまして。定期的に200ページ程のレポート作成があり、今回からはコピペ手作業をやめたい!と思い、参考にさせて頂いております。ありがとうございます。
ペーストする際、「新規プレゼンテーション作成」もしくは「スライド追加」の方法を教えていただいたのですが、すでにページネーションされているパワポ資料があり、指定したスライドにグラフを貼りたい(例:スライドP41~50まで、10シートのグラフ(グラフを含んだ範囲のセルを選択しコピー)をそれぞれ貼り付けたい)という場合、スライドを指定してグラフを貼りつけることは可能でしょうか・・?初心者ゆえ、実現可能かどうかわからず、恐れ入りますがご教示頂けますと幸いです。よろしくお願いいたします!
Mashさん、コメントありがとうございます。過去にも同じような質問がございましたので書いたことがあります。
こちらの記事が参考になるのではないでしょうか。お試しください。
*youさん、早急にご返信頂きありがとうございます。
教えて頂いた記事で試してみたところ、解決いたしました!ありがとうございました!
こちらこそご報告ありがとうございます! お役に立てまして光栄です(*´∀`)
はじめまして。
エクセルの表を張り付ける作業を毎週実施する予定の中
手作業から脱却したく検索したら本サイトに行きつきました。
本当に目から鱗でこんなことできるのかと大変助かっております。
作成している中で是非アドバイス頂きた事がありご質問させていただきます。
既存のパワーポイントのスライド(たとえば10ページ作成)に追加でこのVBAを利用して
複数枚のスライドをのエクセルのシートコピーで追加させるためにはどうしたらいいのでしょうか?
今現在いい感じで新規パワーポイントファイルとしてエクセルの表をコピーしスライド作成(計6ページ)のVBAは動かせています。ご教示頂けると助かります。
一枚追加のプログラムは拝見したのですが、今の複数枚のプログラムに何かコードを追加して
既存(開いているパワーポイントファイルのスライド末から)ファイルに追加が出来ると
うれしいです。できたスライドコピーすればいいんですが・・・ここまでくるとやりたくて。。
中城さん、コメントありがとうございます。
もう7年も前に書いた記事に未だに需要があって嬉しい限りです。「ここまでくるとやりたくて」という気持ちこそプログラミング上達の一歩だと思います! 記事の最後のほうに追記しましたのでご参照ください。
*youさん
早速のご返信並びにコードまでありがとうございます!!
また、ご返信遅くなり大変申し訳ありません。まさかこんなレスポンスが早いとは
思ってもみませんでした・・。感謝感謝でございます!
早速利用してみて、無事こちらが望んでいる動きをしてくれました!
ありがとうございました!
中城さん、こちらこそお返事遅れてすみません~! お望みの動きになったようでなによりです!
はじめまして。
Excelマクロ入門者です。
社内ヘルプデスク業務をしています。
パワーポイントの自動化を探していたらこちらのHPに辿り着きました。
毎月、対応件数と詳細をExcelの表に記録しております。翌月月初にパワーポイントのスライドへ、Excelの表の形式を変えずに貼り付けて、上司へ報告しています。
見出し列は変更ありませんが、縦の件数については月々によって件数が変わります。
毎回、スライドへコピペしているのですが、貼り付け位置などがズレてしまいます。
ネット検索するとパワーポイントへグラフを自動貼り付けの解説は見つかるのですが、Excelの表を貼り付けて、サイズを整えるなどの自動化のHPは見つかりませんでした。
Excelの表を図形形式やExcelのリンク形式ではなく、貼り付けたい後にフォントの変更も出来るように「元の書式を残して貼り付け」たいです。
(イメージとしては、※youさんのグラフの元となるExcelの表をスライドに貼り付ける感じです)
どのようにマクロを作れば良いのかわかりません。教えてください。
よろしくお願いいたします。
まさひろさん、コメントありがとうございます。表の貼り付けは以前も話題に上ったことがあって、今ならできそうだなと思ったので新しく記事にしてみましたのでご参照ください。
コメントは承認制ですので、反映までしばらくお待ち下さい。(稀にスパムの誤判定にて届かないこともあるようですので、必要な際はお問い合わせからお願い致します。)
YouTubeでQ&Aコンテンツを企画しています
運営しているYouTubeチャンネルで、ご相談やご質問を募集しています。動画のコメントやお問い合わせページからお気軽にご相談をお寄せください。