読者です 読者をやめる 読者になる 読者になる

CGメソッド

CG制作に関してのヒント

MENU

【PowerPoint】複数のデータ(.pptx)を一つにまとめる方法

複数のデータ(.pptx)を一つにまとめる方法

・挿入したいパワポデータをドラッグ&ドロップ

・新しいスライド>スライドの再利用

など、標準機能でもまとめる方法はありますが、マクロ使うのが一番ラクでした。

参考元

ameblo.jp

マクロからパワポのデータを複数選択して実行するだけです。

各ファイルのデザインテンプレートが1種類ずつの場合

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