エクセルからパワポを自動作成するマクロ

「同じフォルダに保管されているエクセルファイルからパワポを作成するマクロ」

たなぴーさんの動画を参考に作成しました。
https://www.youtube.com/watch?v=ny-s9EgZva4&t=406s

フォルダ内

エクセルの各シート上のグラフを張り付け

コード

qiita.rb

Option Explicit

Sub mkPpt()

'PPT化したエクセルファイルを指定
Workbooks.Open ("C:\デスクトップ\VBA\パワポデータ貼り付け\パワポ作成.xlsx")

Dim myWs1 As Worksheet
Dim myWs2 As Worksheet
Dim myWs3 As Worksheet, numDate As Long

Set myWs1 = Worksheets("sheet1") 'sheet1をセット
Set myWs2 = Worksheets("sheet2") 'sheet2をセット
Set myWs3 = Worksheets("sheet3") 'sheet3をセット

numDate = myWs1.Cells(1, 10).Value

Dim ppApp As New PowerPoint.Application
Dim ppPrs As PowerPoint.Presentation

Set ppPrs = ppApp.Presentations.Open(ThisWorkbook.Path & "\パワポ.pptx")
Dim ppSld As PowerPoint.Slide 'スライドオブジェクト
Dim pic As PowerPoint.Shape

ppApp.Visible = True

'■■■■■■1ページ目■■■■■■

Set ppSld = ppPrs.Slides(1) '1ページ目のスライドをセット

ppSld.Shapes("ReportDate").TextFrame.TextRange.Text _
                = Format(numDate, "'yy/m/d(aaa)") & "報告"
ppSld.Shapes("TextBox1").TextFrame.TextRange.Text = myWs2.Cells(14, 4) & " " & myWs2.Cells(15, 4)
Range(myWs1.Cells(7, 2), myWs1.Cells(18, 8)).CopyPicture xlScreen, xlPicture 'グラフを画像としてコピー

Set pic = ppSld.Shapes.Paste.PlaceholderFormat.Parent

    pic.Name = "図1"
    pic.Top = 90
    pic.Left = 50
    pic.Width = 600
    pic.ZOrder msoSendToBack '最背面



'■■■■■■2ページ目■■■■■■

Set ppSld = ppPrs.Slides(2) '2ページ目のスライドをセット

ppSld.Shapes("ReportDate").TextFrame.TextRange.Text _
                        = Format(numDate, "'yy/m/d(aaa)") & "報告"
'ppSld.Shapes("TextBox1").TextFrame.TextRange.Text = myWs.Cells(14, 11) & " " & myWs.Cells(15, 11)
Range(myWs2.Cells(1, 6), myWs2.Cells(12, 12)).CopyPicture xlScreen, xlPicture 'グラフを画像としてコピー

Set pic = ppSld.Shapes.Paste.PlaceholderFormat.Parent

    pic.Name = "図1"
    pic.Top = 200
    pic.Left = 250
    pic.Width = 600
    pic.ZOrder msoSendToBack '最背面

'■■■■■■3ページ目■■■■■■

Set ppSld = ppPrs.Slides(3) '3ページ目のスライドをセット

ppSld.Shapes("ReportDate").TextFrame.TextRange.Text _
                        = Format(numDate, "'yy/m/d(aaa)") & "報告"
'ppSld.Shapes("TextBox1").TextFrame.TextRange.Text = myWs.Cells(14, 18) & " " & myWs.Cells(15, 18)
Range(myWs3.Cells(9, 2), myWs3.Cells(20, 8)).CopyPicture xlScreen, xlPicture 'グラフを画像としてコピー
Set pic = ppSld.Shapes.Paste.PlaceholderFormat.Parent

    pic.Name = "図1"
    pic.Top = 90
    pic.Left = 50
    pic.Width = 600
    pic.ZOrder msoSendToBack '最背面

'■■■■■■終了手続き■■■■■■

Application.DisplayAlerts = False
ppPrs.SaveAs ThisWorkbook.Path & "\パワポ_" & Format(numDate, "yyyymmdd") & ".pptx"
Application.DisplayAlerts = True

'ppApp.Quit

Workbooks("パワポ作成.xlsx").Close

MsgBox "スライドサイズ" & vbLf & "幅：" & ppPrs.PageSetup.SlideWidth _
& vbLf & "高さ：" & ppPrs.PageSetup.SlideHeight & vbLf & "です!", vbInformation

Application.CutCopyMode = False

End Sub