PowerPoint│複数の.pptxを一つのファイルに結合する方法

Sub Pre_InsertFromFile1()
　'各ファイルのデザインテンプレートが1種類ずつの場合
　Dim newPre As Presentation '新規プレゼンテーション
　Dim myPre As Presentation '既存プレゼンテーション
　Dim i As Long, j As Long
　Dim LstSld As Long, CntSld As Long
　Dim ArrSld() As Long
　Dim fd As FileDialog 'ファイルダイアログ
　'任意の*.pptファイル呼び出し
　Set fd = Application.FileDialog(msoFileDialogOpen)
　With fd
　　.InitialFileName = "C:" '"E:\Office\PowerPoint\VBAコード"
　　.Filters.Add "PowerPoint File", "*.ppt;*.pptx;*.pptm;*.pps", 1
　　If .Show <> -1 Then Exit Sub
　End With
　'新規プレゼンテーション
　Set newPre = Presentations.Add
　For i = 1 To fd.SelectedItems.Count
　　Set myPre = Presentations.Open(fd.SelectedItems.Item(i), _
　　　　　　　　　　　　　　msoTrue, , msoFalse)
　　With newPre.Slides
　　　LstSld = .Count '新規プレゼンの最後のスライド番号
　　　CntSld = myPre.Slides.Count
　　　'既存プレゼンから新規プレゼンに挿入
　　　.InsertFromFile myPre.FullName, LstSld, 1, CntSld
　　　ReDim ArrSld(1 To CntSld)
　　　For j = 1 To CntSld
　　　　ArrSld(j) = LstSld + j
　　　Next j
　　　'既存プレゼンスライド1のデザインをまとめて貼り付け
　　　.Range(ArrSld).Design = myPre.Slides(1).Design
　　End With
　　myPre.Close
　Next i
End Sub

Sub Pre_InsertFromFile2()
　'各ファイルのデザインテンプレートがスライドごとにばらばらな場合
　Dim newPre As Presentation '新規プレゼンテーション
　Dim myPre As Presentation '既存プレゼンテーション
　Dim myDes As Design 'デザイン
　Dim i As Long
　Dim j As Long
　Dim fd As FileDialog 'ファイルダイアログ
　'任意の*.pptファイル呼び出し
　Set fd = Application.FileDialog(msoFileDialogOpen)
　With fd
　　.InitialFileName = "C:" '"E:\Office\PowerPoint\VBAコード"
　　.Filters.Add "PowerPoint File", "*.ppt;*.pptx;*.pptm;*.pps", 1
　　If .Show <> -1 Then Exit Sub
　End With
　'新規プレゼンテーション
　Set newPre = Presentations.Add
　For i = 1 To fd.SelectedItems.Count
　　Set myPre = Presentations.Open(fd.SelectedItems.Item(i), _
　　　　　　　　　　　　　　msoTrue, , msoFalse)
　　With myPre.Slides
　　　For j = 1 To .Count
　　　　With .Item(j)
　　　　　Set myDes = .Design 'デザインコピー
　　　　End With
　　　　'既存プレゼンから新規プレゼンテーションに1枚1枚挿入
　　　　With newPre.Slides
　　　　　.InsertFromFile myPre.FullName, .Count, j, j
　　　　　With .Item(.Count)
　　　　　　.Design = myDes '1枚1枚デザイン貼り付け
　　　　　End With
　　　　End With
　　　Next j
　　End With
　　myPre.Close
　Next i
End Sub

Sub resizeA4()
''図形をA4にリサイズ
takasa = 28.355 * 19.05:   '高さ指定。5.3cm
haba = 28.355 * 27.51: '幅指定。7.07cm
With ActiveWindow.Selection
If .Type = ppSelectionNone Or _
.Type = ppSelectionSlides Then Exit Sub
With .ShapeRange
.LockAspectRatio = msoFalse: '縦横比を固定をしない。
.Height = takasa: '高さ設定
.Width = haba: '幅設定
'縦横比を固定にしたい場合は.LcokAspect~の行を削除し、
'幅基準（高さはなり）ならば、.Heightの行も削除する。
End With
End With
''図形を中心に移動
Dim sld_w As Single ''スライドの横幅
Dim sld_h As Single ''スライドの高さ
Dim shp_w As Single ''Shapeの横幅
Dim shp_h As Single ''Shapeの高さ
Dim msg As String
With ActiveWindow.Selection
''図形が選択されていない場合はマクロを終了
If .Type = ppSelectionNone _
Or .Type = ppSelectionSlides Then
msg = "中央に配置したいShapeを選択してください。"
MsgBox msg
Exit Sub
End If
''スライドのサイズを取得
sld_w = .SlideRange.Master.Width
sld_h = .SlideRange.Master.Height
''図形のサイズを取得
shp_w = .ShapeRange.Width
shp_h = .ShapeRange.Height
''図形の位置を移動
.ShapeRange.Left = (sld_w - shp_w) / 2
.ShapeRange.Top = (sld_h - shp_h) / 2
End With
End Sub