Bye Bye Moore

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

VBAマクロでExcelからWordやPowerPointに値を貼り付ける その4:すでにあるシェイプに値を流し込む

shuzo-kino.hateblo.jp
の続き

一歩進んで、すでにレイアウトされているシェイプに流し込む方法を検討。

実際のところ

こんな感じのシートを用意します。
オレンジを最初に、次に緑を生成しました。
f:id:shuzo_kino:20210715234635p:plain

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(1).TextFrame _
        .TextRange.Text = excelstr

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

結果はこんな感じに。1始まりみたいです。
f:id:shuzo_kino:20210715234801p:plain

実験してみたところ、追加された順番に番号が振られれる様子。
途中で消したり入れ替えるとまた違うかもしれませんが……。