Bye Bye Moore

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

VBAマクロでExcelからWordやPowerPointに値を貼り付ける その3:テキストフレームに要素を反映する

shuzo-kino.hateblo.jp
の続き

多分、ほとんどの人にとっては本命のネタ。
Excelシートから内容ひっぱりだして、スライド内にテキストエリアとして貼り付ける方法について。

実際のところ

PPTにテキストフレームを追加する

まずはExcelは無しで単純にマクロ越しにテキストフレームを追加してみます

Sub Test()
Set myDocument = ActivePresentation.Slides(1)

With myDocument.Shapes _
        .AddShape(msoShapeRectangle, 180, 175, 350, 140).TextFrame
    .TextRange.Text = "Here is some test text"
    .MarginTop = 10
End With
End Sub

実行すると、青い四角が出てきます。
イマドキのPPTはデフォが色付きだからですかね。
f:id:shuzo_kino:20210714233012p:plain

Excelからデータを引っ張りだして、テキストフレームに流し込む

では本題。
先ほどの結果を踏まえて、Excelシートから結果を取得、流し込みます。

Sub Test()
    
    '変数の定義
    Dim excelFilePath As String
    Dim sheetName As String
    Dim rngCopy As String
    Dim dstSlide As Long
    Dim excelstr As String
    
    
    excelFilePath = "C:\Users\user\Desktop\Book1.xlsm"
    sheetName = "Sheet3"
    rngCopy = "A3"
    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
 
    'セルをコピー
    excelstr = wb.Sheets(sheetName).Range(rngCopy)
    
    'PPTの指定スライドに張り付ける
    ppt.Slides(dstSlide).Shapes.AddShape(msoShapeRectangle, 180, 175, 350, 140).TextFrame _
        .TextRange.Text = excelstr

    
    'Excelをとじる
    wb.Close SaveChanges:=False
    eApp.Quit
    Set wb = Nothing: Set eApp = Nothing
    
End Sub

f:id:shuzo_kino:20210714235201p:plain

すでにあるシェイプに値を流し込む場合は、シェイプの通し番号を指定して値を流し込む様子。
これは次回やります。