Bye Bye Moore

PoCソルジャーな零細事業主が作業メモを残すブログ

VBAマクロでExcelからWordやPowerPointに値を張り付ける その2:テーブルとして貼り付ける

実際のところ

パワポ側で実行するマクロです。
デフォだとExecelのオブジェクトを読みださないので、「ツール」=>「詳細設定」をひらき、Excelオブジェクト読み出しを有効にします。
f:id:shuzo_kino:20210714003537p:plain
これがないと、「ユーザー定義マクロが定義されていません」てなエラーを吐いて先に進めません。

マクロ本体

写経元では関数とDIMに分かれてましたが、理解のためバラしました。
その過程でエラー処理も殴り捨てた侠気仕様。

Sub Test()
    '変数の定義
    Dim excelFilePath As String
    Dim sheetName As String
    Dim rngCopy As String
    Dim dstSlide As Long
    
    excelFilePath = "C:\Users\user\Desktop\Book1.xlsm"
    sheetName = "Sheet3"
    rngCopy = "A1:B4"
    dstSlide = 1
    
    'Excelシートから値を確保する
    Dim eApp As Excel.Application, wb As Excel.Workbook, ppt As PowerPoint.Presentation
    Set eApp = New Excel.Application
    eApp.Visible = False
    Set wb = eApp.Workbooks.Open(excelFilePath)
    Set ppt = ActivePresentation
 
    'セルをコピー
    wb.Sheets(sheetName).Range(rngCopy).Copy
    
    'PPTの指定スライドに張り付ける
    ppt.Slides(dstSlide).Shapes.PasteSpecial ppPasteBitmap
    
    'Excelをとじる
    wb.Close SaveChanges:=False
    eApp.Quit
    Set wb = Nothing: Set eApp = Nothing
    
    'PPTの表を位置揃え
    If Not (IsMissing(shapeTop)) Then
        With ppt.Slides(dstSlide).Shapes(ppt.Slides(dstSlide).Shapes.Count)
            .Left = shapeLeft
            .Top = shapeTop
        End With
    End If
End Sub

結果

真っ新なPPTファイルならタイトル入力のアレになってると思います。
これに、指定範囲のExcelファイルから作られたテーブルが追加されます。
f:id:shuzo_kino:20210714003317p:plain