PowerPoint ファイルの結合方法

フォルダの中にある多数のPPTファイルについて、各PPTファイルの全てのスライドを結合して新しいPPTファイルを作成したいと考えています。

色々とWEB上で探して、下記サイトが参考にして、各ファイル1ページ目のみを結合できるようになったのですが、各ファイル全てのページを結合する方法がわからず困っております。
アドバイスいただける方がおりましたらお願いいたします。
OSは、Windows7、Officeは2010を使用しています。

■参考にしたサイト
http://oshiete.goo.ne.jp/qa/1286531.html

■現状のコード（PPTのVBAです。）
上記参考サイトのコードをOffice2010に改良しました。
VBAの初心者なので、コードについてご指摘もいただければ幸いです。
※2010で動くようにしただけで精いっぱいでした。

Sub test1()
Dim openFilePath As String
Dim fn As String
Dim f As Object
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")

openFilePath = "I:\test"
  
  For Each f In FSO.GetFolder(openFilePath).Files
    fn = f.Name 'ファイル名の取得
                
    With Presentations.Open(openFilePath & "\" & fn)
    Presentations(fn).Slides(1).Copy '←スライド1のみコピー。
    Presentations(fn).Close
    ActiveWindow.View.Paste
    End With
  Next f
Set FSO = Nothing

End Sub

行動規範の内容に同意します

回答1件

こんにちは

Excelではよくやるのですが、PowerPointではやったことがなかったので試してみました。

こんな感じでいかがでしょう？

lang
1Sub test1()
2    Dim openFilePath As String
3    Dim fn As String
4    Dim f As Object
5    Dim FSO As Object
6    Set FSO = CreateObject("Scripting.FileSystemObject")
7    Dim myPtt As Presentation
8
9    'コピー先（自分）の保持
10    Set myPtt = ActivePresentation
11
12    '検索フォルダ
13    openFilePath = "I:\test"
14
15    'フォルダ内のファイルを取得
16    For Each f In FSO.GetFolder(openFilePath).Files
17
18      'ファイル名の取得
19      fn = f.Name
20
21      '拡張子 pptx で判別
22      If FSO.GetExtensionName(openFilePath & "\" & fn) = "pptx" Then
23
24        'コピー元ファイルを開く
25        Presentations.Open (openFilePath & "\" & fn)
26
27        With ActivePresentation
28          'コピー元から全スライドをコピー
29          .Slides.Range.Copy
30          'コピー元を閉じる
31          .Close
32        End With
33
34        'コピー先へ貼り付け
35        myPtt.Slides.Paste
36
37      End If
38
39    Next f
40
41    Set FSO = Nothing
42
43End Sub