ExcelVBAにて既に開かれているPowerpointをアクティブにするには？

Excel2010です。

題名の通り既に開かれてるパワーポイントのファイル「test.pptx」をExcelVBAにて
操作するためにはどのようにしたら良いでしょうか？

調べたところ新規作成やオープンしてからの操作の記述は見つかりましたが
既に開かれてるpptxを操作するコードが見つからなかったので
こちらで質問させていただきました。

是非とも宜しくお願いします。

Sub PowerPointファイルを開く()

Dim ppApp As New PowerPoint.Application
ppApp.Visible = True

Dim ppPrs As PowerPoint.Presentation

'PowerPoint新規作成
'Set ppPrs = ppApp.Presentations.Open(ThisWorkbook.Path & "\test.pptx")

'PowerPoint新規プレゼンテーション作成
' Set ppPst = ppApp.Presentations.Add(WithWindow:=True)

'既に開かれているpptx取得
Set ppPst = ppApp.Presentations.???

End Sub

No.2 ベストアンサー 回答者： WindFaller 回答日時： 2019/01/28 19:34

遅くなりました。

5年以上もパワポのマクロを書いていないので、大したものはできませんが、写真を貼り付けるなら、こういうことが可能です。新しいスライドに貼り付けるものです。
その新しいスライドは、最後のスライドをコピーするようにできています。


'//標準モジュール
Sub Pic2PPT()
　Dim objPPT As Object 　　'PowerPoint.Application '参照設定の場合
　Dim pic As Variant
　Dim pptSlide As Object 'Slide
　Dim pCustomtLayout As Object 'CustomLayout
　Const ppPasteMetafilePicture As Long = 3 '参照設定していたら不要
　Dim i As Long
　On Error Resume Next
　Set pic = Selection
　If TypeName(pic) <> "Picture" Then
　　MsgBox "画像を選択して、実行してください。", vbCritical
　　Exit Sub
　End If
　Set objPPT = GetObject(, "PowerPoint.Application")
　If objPPT Is Nothing Then
　　MsgBox "PowerPointは、立ち上がっていません。", vbExclamation: Exit Sub
　Else
　　With objPPT.ActivePresentation
　　　i = .Slides.Count
　　　.Slides.AddSlide Index:=i + 1, pCustomlayout:=.Slides(i).CustomLayout
　　　pic.Copy
　　　Set pptSlide = .Slides(i + 1)
　　　pptSlide.Shapes.PasteSpecial (ppPasteMetafilePicture)
　　End With
　End If
　AppActivate objPPT.ActiveWindow.Caption & " - PowerPoint"　　'PPTのアクティベート
　Set objPPT = Nothing
　If Err.Number <> 0 Then
　　MsgBox "失敗しました。", vbCritical
　End If
　On Error GoTo 0
End Sub

'Excelの見本の画面・ボタンはフォームボタン

この回答へのお礼

お礼が遅くなり申し訳ありませんでした。
有難うございます、助かりました。

お礼日時：2019/01/30 09:27

No.1 回答者： WindFaller 回答日時： 2019/01/24 00:42

こんばんは。

こうしてみたらいかがでしょうか。

Sub GetPPT()
　Dim objPPT As Object
　On Error Resume Next
　Set objPPT = GetObject(, "PowerPoint.Application")
　If objPPT Is Nothing Then
　　MsgBox "PowerPointは、立ち上がっていません。", vbExclamation: Exit Sub
　Else
　　MsgBox objPPT.Windows.Application.Caption & "は、開かれています。"
　End If
End Sub

この回答へのお礼

ありがとうございます。
私の説明不足で申し訳ありませんがこの後の動作としては
「開かれてるパワーポイントにexcelの範囲を画像として貼り付けたい」
でした。

Windfallerさんのコードで開かれてるppstの取得とactive化までは出来ましたが
その後の動作が出来ませんでした。
恐れ入りますがご指導よろしくお願いします。


Dim objPPT As Object
On Error Resume Next
Set objPPT = GetObject(, "PowerPoint.Application")
If objPPT Is Nothing Then
MsgBox "PowerPointは、立ち上がっていません。", vbExclamation: Exit Sub
Else
'MsgBox objPPT.Windows.Application.Caption & "は、開かれています。"
End If

Set ppPst = ppApp.Presentations(objPPT)

お礼日時：2019/01/24 10:50