エクセルからパワポへ転記

投稿者 : たける     投稿日時 : 2022/06/21(Tue) 22:52:42     OS : Windows 10     EXCEL : Excel 2019

---

エクセルのデータをパワポに転記するvbaコードを知りたいです。
具体的にはあらかじめ転記用のテンプレートパワポファイルを参照しておき、作成のマクロボタンを押すと、パワポのテキストボックス1にエクセルのシート2のB2のデータを転記、 パワポのテキストボックス2にエクセルのシート2のH6のデータを転記、パワポのテキストボックス3にエクセルのシート2のA8のデータを転記するという感じでエクセルから転記したいものが沢山あります。
転記後のパワポファイルは○○依頼書という名前で保存する形がいいです。○○の部分はエクセルのシート2のB2の言葉をいれたいです。

上記のようなvbaは作成可能でしょうか？

投稿者 : てらてら     投稿日時 : 2022/06/22(Wed) 06:41:45

---

こんにちは。

パワポへの転記は、パワポのオブジェクトの使い方が一般的でないのでちょっと敷居が高くなります。
以前、同じような事をしたので改造してみました。
参考にしてください。

Sub Excel2Ppt()

    Dim ppApp As Object, r As Long, c As Long
    Dim readPPtPath As String
    Dim myPath As String
    
    readPPtPath = ThisWorkbook.Path & "\temp.pptx"
    
    Set ppApp = CreateObject("PowerPoint.Application")
    With ppApp
    .Visible = True
    .Presentations.Open readPPtPath
    
    'シェイプ(1)に文字列を入れる
    .ActiveWindow.View.Slide.Shapes(1).TextFrame.TextRange.Text = Worksheets("Sheet2").Range("B2")
    'シェイプ(2)に文字列を入れる
    .ActiveWindow.View.Slide.Shapes(2).TextFrame.TextRange.Text = Worksheets("Sheet2").Range("H6")
    .ActiveWindow.View.Slide.Shapes(3).TextFrame.TextRange.Text = Worksheets("Sheet2").Range("A8")
    
    
    
    
    '保存するパス名
    myPath = ThisWorkbook.Path & "\" & Worksheets("Sheet2").Range("B2") & "依頼書.pptx"
    
    .ActivePresentation.SaveAs myPath
    .Presentations(myPath).Close
    .Quit
    
    
    End With

    Set ppApp = Nothing

    Application.CutCopyMode = False
    
End Sub

投稿者 : たける     投稿日時 : 2022/06/22(Wed) 20:06:46

---

ありがとうございました。
参考した所、うまく動作できました！