メニュー

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

powerpoint-combine-multiple-data

複数のパワポのデータをまとめたい時はないでしょうか?

本記事では複数のデータ(.pptx)を一つにまとめる方法を紹介します。

一枚にまとめて提出する時やまとめて印刷する時に使える技です!

目次

海外でフリーランスをしているテクニカルアーティスト
ゲーム開発・映像制作・WEB制作等を請け負っています。
当ブログは作業効率化のための技術ブログです。

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

標準機能のみでできます。

  • 挿入したいパワポデータをドラッグ&ドロップ
  • 新しいスライド>スライドの再利用

ただ、この作業はマクロ使うのが一番ラクです。

PowerPointでマクロで複数の.pptxを一つにまとめる方法

続いてマクロを使う方法です。

  1. 開発タブ>Visual Basicを選択して開きましょう。
  2. 標準モジュールにコードを挿入して実行
  3. 実行後、パワポのデータをShiftで複数選択してください

テンプレートのデザインが1種類の場合のデータを結合するマクロ

テンプレートのデザインが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

おまけ│PowerPointで図形をA4にリサイズして、A4スライドにぴったり合わせるマクロ

pptデータではなく、画像素材をまとめる場合はこちらのマクロが良いです。

複数のA4のパワポデータを一つのパワポにまとめて印刷するために、pptデータをpptデータへひたすらドラック&ドロップ&リサイズをしていたのですが、マクロ書いとけばよかったということで、リサイズの部分だけ書いてみました。

コード
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

まとめ

1つや2つはいざしらず、20も30もパワポデータを統合しないといけない場合はマクロを覚えて実行してしまいましょう!

全記事一覧

  • URLをコピーしました!
目次