質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

1回答

5047閲覧

Excel VBAによるPowerpointへの画像の貼り付け

chom

総合スコア0

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2022/08/21 14:54

前提

VBA初心者です。
Excel VBAのみでPowerpointへの画像の貼り付け等を行いたいです。

実現したいこと

Excel VBAを用いて指定のフォルダ内の複数の画像をPowerPointのスライドに並べたいです。

現在、下記のコードによりフォルダ内の1枚の画像をExcelに貼り付ける → ExcelからPowerPointのスライドに画像を貼り付けるということはできましたが、以下2点の方法が分かりません。
①フォルダ内の画像をそのままPowerpointへ貼り付ける
②フォルダ内にある複数の画像をPowerPointへ貼り付ける

どうかご教授お願い致します。

発生している問題・エラーメッセージ

エラーメッセージ

### 該当のソースコード ```VBA ソースコード Sub Image02() Dim ws As Worksheet Set ws = ThisWorkbook.Worksheets("画像") With Sheets("画像").Pictures.Insert("C:\Users\xxxx\Desktop\xxx\xx.jpg") .Top = Range("B2").Top .Left = Range("B2").Left If .Width > Range("B2").Width Then .Width = Range("B2").Width End If If .Height > Range("B2").Height Then .Height = Range("B2").Height End If .Cut End With With Sheets("画像") ws.Range("B2").Select .Pictures.Paste End With '------------------------------------------------- Dim ppApp As New PowerPoint.Application Dim ppPt As Presentation Dim ppSlide As Slide Dim ppShape As PowerPoint.Shape 'ppApp.Visible = True Set ppPt = ppApp.Presentations.Open(ThisWorkbook.Path & "\sample.pptx") 'スライド番号1を指定 Set ppSlide = ppPt.Slides(1) Set ws = ThisWorkbook.Worksheets("画像") 'セル範囲を画像で貼りつけ ws.Range("B2").CurrentRegion.Copy 'PasteSpeciaでエラーが出るときは、ここに待ちを作ります。 ppSlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile, Link:=msoFalse Set ppShape = ppSlide.Shapes(ppSlide.Shapes.Count) '最後の図形 ppShape.Top = Application.CentimetersToPoints(1) '上位置 ppShape.Left = Application.CentimetersToPoints(1) '左位置 ppShape.LockAspectRatio = msoTrue '縦横比を固定 ppShape.Width = Application.CentimetersToPoints(10) '横幅 End Sub

試したこと

補足情報(FW/ツールのバージョンなど)

ここにより詳細な情報を記載してください。

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答1

0

B2にフォルダー
B6~ファイル名、セット位置

記載されたExcelの表 から パワポのスライドを作成する

処理イメージが合っているか?自信がないのですが、下記のように作成してみました。
https://www.youtube.com/watch?v=ELYLw9dn5Y4
↑こんな感じでテストしてみました。
コードをアレンジして使ってみてください。

Excelシートのイメージ
イメージ説明

ポイント
.Shapes.AddPicture で パワポのスライドに画像ファイル指定で図を挿入できるので、
Excel経由で.Copyしなくても、大丈夫そうです。
Shapes.AddPicture をぐぐってみてください。

ソースコード

Excelの画像ファイルリストから、
パワポのスライドを作成してみます。

VBA

1Sub ExcelからPowerPointへ画像ファイルをセット20220823() 2 3 Dim ppApp As Object 'PowerPoint.Application 4 Set ppApp = CreateObject("PowerPoint.Application") 5 ppApp.Visible = True 6 '新規プレゼンファイルの追加 https://www.youtube.com/watch?v=5ZQMhv0s9qs 7 ppApp.Presentations.Add '新規プレゼンの追加 8 9 Dim objSlide As Object 'スライドオブジェクト 10 Dim objPicture As Object '図 Picture 11 12 Dim r As Range 'ファイルの表、基準の位置 表の左上 B5 13 Dim p As Integer 'パワポ側Page と Excel表の行カウンタ 14 Dim strFNAME As String '画像ファイル名 15 16 Set r = Range("B5") 'セット開始位置 B6からセット 17 p = 1 'スライドのPページ目、兼、画像のP枚目として使用 18 19 While Trim(r.Offset(p, 0) & "") <> "" 'ファイル名が空になるまでループ 20 'パワポのスライドを追加する https://www.youtube.com/watch?v=0oHFihJNTLo 21 'p枚目のスライド追加 レイアウトは12 ppLayoutBlank 22 Set objSlide = ppApp.ActivePresentation.Slides.Add(p, 12) 23 'ActiveWindow.Selection.SlideRange.Layout = 12 '12:ppLayoutBlank 24 25 '画像ファイル名はB2のフォルダ+ファイル名です b2は\xxxxx\と\で終わってね 26 strFNAME = Trim(Range("B2")) & r.Offset(p, 0) 'ファイル名 27 28 '画像ファイルを挿入 画像ファイル名を指定してとりあえず0,0に挿入 29 Set objPicture = objSlide.Shapes.AddPicture(strFNAME, False, True, 0, 0) 30 31 '図 画像 の プロパティをセット ↑上で挿入された画像のプロパティを調整 32 With objPicture 33 .Top = r.Offset(p, 1) '位置 上 34 .Left = r.Offset(p, 2) '位置 左 35 .Width = r.Offset(p, 3) '幅 36 .Height = r.Offset(p, 4) '高さ 37 End With 38 39 '次のデータ、次のスライドページへ 40 p = p + 1 41 Wend 42 43 MsgBox "処理終了 パワポを確認してください" 44 'ここまで 45 46End Sub

余談:知恵袋の方に
https://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q12266756512
私が勘違い・変な回答してしまいましたが、
こちらのExcel VBAが本命ですよね?

投稿2022/08/23 04:00

編集2022/08/23 04:04
ken3memo

総合スコア132

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

まだベストアンサーが選ばれていません

会員登録して回答してみよう

アカウントをお持ちの方は

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問