Q&A
作成されているコードとそのコードではどのように不都合があるのかを
を質問に記載されると回答が得られやすいと思います。
前提・実現したいこと
お世話になります。初心者です。
エクセルの表を1行ずつパワポの1スライドに貼り付けるVBAについてです。
イメージとしましては
行に1セルずつ「個数」「商品」「売上個数」と横に並んでいて、列に「1月」「2月」「3月」…と縦に並んでいます。
個数 商品 売上 個数
1月 100 りんご 50
2月 230 トマト 100
3月 280 いちご 200
4月 350 メロン 350
5月 390 もも 390
6月 410 なし 200
この表を1行ごとにパワポの1スライドに貼り付けたいです。
1月の「個数」「商品」「売上個数」を1スライド目に
2月の「個数」「商品」「売上個数」を2スライド目に
3月の「個数」「商品」「売上個数」を3スライド目に…
といったようなイメージです。
出来ればテキストではなくエクセルの表の書式（セルの幅やフォントなど）のまま貼り付けていきたいです。
このようなことは可能でしょうか。
エクセルのVBAで1行ずつの値を貼り付けることはできましたが、
書式が反映されず、パワポのVBAを利用する必要がある、ということまではたどり着きました。
補足情報（FW/ツールのバージョンなど）
現在PPT2016を使用しています。
現在excelで使用しているソースコードです。
Sub test()
Const ppLayoutBlank = 12
Dim i As Long
With CreateObject("PowerPoint.Application")
With .Presentations.Add
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
Cells(i, "A").Resize(1, 4).Copy
With .Slides.Add(i - 1, ppLayoutBlank)
.Shapes.PasteSpecial
End With
Next i
End With
End With
End Sub
ご指摘ありがとうございます。
現在excelのVBAでから貼り付ける作業はできるようになっているのですが、
PPTのVBAは素人のため質問をいたしました。
以下が現在excelで使用しているコードです。
Sub test()
Const ppLayoutBlank = 12
Dim i As Long
With CreateObject("PowerPoint.Application")
With .Presentations.Add
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
Cells(i, "A").Resize(1, 4).Copy
With .Slides.Add(i - 1, ppLayoutBlank)
.Shapes.PasteSpecial
End With
Next i
End With
End With
End Sub
これでやるとexcelの書式が反映されない、といった状況です。
よろしくお願いいたします。
画像貼り付けはNGで、貼り付け後も編集されますか？
あと、コードは質問を編集して追記されると良いですよ。こちらでは見逃すことがありますので。
できれば画像出ないほうが良いですが、難しい場合にはその限りではありません。
ご指摘ありがとうございます。
ソースコードを追記いたしました。
回答3件
0
Excelオブジェクトとして貼り付けはOKでしょうか？
PasteSpecialのパラメーターにDataTypeを追加してください。
VBA
1.Shapes.PasteSpecial DataType:=ppPasteOLEObject
尚、ppPasteOLEObjectを指定するには参照設定で「Microsoft PowerPint XX.X Object Library」を有効にしてください（XX.Xは使用しているOfficeのバージョンにより変わります）。
参照設定したくないときは「10」を指定してください（今後値が変わることがないとも言えないのでお勧めはしません）
VBA
1.Shapes.PasteSpecial DataType:=10
投稿2020/09/15 07:00
総合スコア17000
参照設定から有効にしましたが、
実行時エラー'2147188160'
.Shapes.PasteSpecial:無効な要求です。クリップボードに何も入っていないか、ここでは貼り付けることのできないデータが入っています。
というエラーメッセージが出てしまいます。
バージョンによって挙動が違うのかもしれませんが、2016なら当方の環境Office365とそう遠くはないのでまた別の問題かもしれません。
「クリップボードに何も入っていない」というエラーも出ていることから、コピーに時間がかかっているのかもしれません。
ただシートの情報を見る限り重いデータではなさそうですが（実際のデータは違うのでしょうけど）
試しにAPIのSleepなんかを使って、Copyのあとにウェイトを入れてみてはどうでしょうか。
ここらへんを参考に。
https://www.sejuku.net/blog/37388
その前にステップ実行で時間を掛けながら動かすとどうなるかは試したほうがいいかもしれません。
それから手動操作で、ポワポ側で「貼り付け」→「埋め込み」ができるかも確認しておいてください。
そもそもこれができないと意味ないですので。
0
コードを書く時間がないので参考URLだけ共有しますね。
https://teratail.com/questions/142599
VBA
1Sub test() 2Dim ppApp As Object 'PowerPointアプリ 3Dim ppPst As Object 'PowerPointプレゼン 4Dim ppSld As Object 'PowerPointスライド 5Dim i As Integer 6 7'PowerPointを起動 8Set ppApp = CreateObject("PowerPoint.Application") 9 10'PowerPointを表示 11ppApp.Visible = msoTrue 12'PowerPoint新規プレゼンテーション作成 13Set ppPst = ppApp.Presentations.Add(WithWindow:=True) 14 15'最終行の取得 16Dim myRow As Long 17 myRow = Cells(Rows.Count, 1).End(xlUp).Row 18 19'Excel各シートの貼り付け 20For i = 2 To myRow 21 Range(Cells(i, 1), Cells(i, 4)).Copy 22 'PowerPointスライド追加 23 Set ppSld = ppPst.Slides.Add(Index:=i - 1, Layout:=12) 24 ppPst.Slides(i - 1).Select 25 26 '貼り付け 27 ppApp.CommandBars.ExecuteMso "PasteAsEmbedded" '埋め込み 28' ppApp.CommandBars.ExecuteMso "PasteExcelTableSourceFormatting" '元の書式 29 30Next 31 32End Sub
・埋め込みで貼り付ければ書式はそのままになります。ダブルクリックをすればExcelが開いて編集できます。
・コメントアウトしていますが、元の書式で貼り付ければ書式や罫線がそのまま貼り付けられるはず、
なのですが、一行だけだと書式が反映されないようです。
二行以上だと書式も反映されるようですがこちらがお好みであれば色々修正してみてください。
こちらのコードはステップインで試せばうまくいくのですが、
そのまま実行してもうまくいかないと思います。
※ExecuteMsoは非同期実行なので、グラフ貼り付けが終わるまで待つ処理がポイントです。
待つ処理は参考URLやその先を見て、ご自身で調整してみてください。
環境によっても異なると思いますので…
投稿2020/09/15 06:33
編集2020/09/16 00:47総合スコア1925
0
追記：コメントを受けて追記
画像として張り付けていいのであれば以下2行変更でいけますね。
VBA
1' ・・・略・・・ 2 'Cells(i, "A").Resize(1, 4).Copy 3 '↓ 4 Cells(i, "A").Resize(1, 4).CopyPicture 5' ・・・略・・・ 6 '.Shapes.PasteSpecial 7 '↓ 8 .Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile 9
これでやるとexcelの書式が反映されない、といった状況です。
質問のコメントに提示のコードで書式付きで貼り付きますよ。
背景色罫線など無視されますがこれは手で(GUIで)同じ操作を行った時と同じです。
背景色罫線など含めて貼り付けたいなら画像として張り付けるとかしかないと思います。
投稿2020/09/15 06:07
編集2020/09/15 06:47総合スコア7918
あなたの回答
tips
プレビュー
