配列変数に指定されたスライドをコピーして新しいプレゼンテーションファイルを作成するPowerPointマクロをご紹介しました。
レポーティング業務などで、定期的に毎回同じスライドでダイジェスト版を作るような場合は、この配列に事前に指定しておくというマクロが便利だと思います。
一方で、ダイジェスト版の元にしたいスライドが、頻繁に変わるというケースもあるように思えます。
その場合、ダイジェスト版を作りたいスライドをPowerPoint上で選択しておいてから実行するマクロのほうが便利かもしれません。
そんなPowerPointマクロを作ってみました。
選択されているスライドをコピーして新規プレゼンテーションファイルを作成するサンプルマクロ
ダイジェスト版に流用したいスライドだけを選択しておいてから、以下のマクロを実行すると、選択されていたスライドのみを含んだ新しいプレゼンテーションファイルが作成されます。
Dim prs_org As Presentation, prs_new As Presentation
Dim pg_org As PageSetup
Dim sld_org As Slide
Dim i As Long, cnt As Long
Dim arr() As Long 'SlideRangeのSlideIndex
Dim x As Long, y As Long, tmp As Long 'arr()のソート用
With ActiveWindow.Selection
If .Type <> ppSelectionSlides Then
MsgBox "コピーするスライドを選択してください。"
Exit Sub
End If
''選択されているスライドのSlideIndexを配列に格納
cnt = .SlideRange.Count
ReDim arr(1 To cnt)
For i = 1 To cnt
arr(i) = .SlideRange(i).SlideIndex
Next i
End With
''配列のソート
For x = LBound(arr) To UBound(arr) - 1
For y = x + 1 To UBound(arr)
If arr(x) > arr(y) Then
tmp = arr(x)
arr(x) = arr(y)
arr(y) = tmp
End If
Next y
Next x
Set prs_org = ActivePresentation
Set pg_org = prs_org.PageSetup
''新しいプレゼンテーションファイルの作成とページ設定のコピー
Set prs_new = Presentations.Add
With prs_new.PageSetup
.SlideSize = pg_org.SlideSize
.SlideOrientation = pg_org.SlideOrientation
.SlideHeight = pg_org.SlideHeight
.SlideWidth = pg_org.SlideWidth
End With
For i = 1 To UBound(arr)
Set sld_org = prs_org.Slides(arr(i))
sld_org.Copy
With prs_new.Slides.Paste
.Design = sld_org.Design
.ColorScheme = sld_org.ColorScheme
.DisplayMasterShapes = sld_org.DisplayMasterShapes
.FollowMasterBackground = sld_org.FollowMasterBackground
End With
Next i
End Sub
サンプルマクロの解説
後半の、新しいプレゼンテーションファイルの作成・ページ設定のコピー・スライドと書式のコピーを行っている部分は、既にご紹介している配列変数で指定されたスライドをコピーして新規プレゼンテーションファイルを作成するマクロと同じです。
前半の、コピーしたいスライドのSlideIndexを配列に格納する処理が、先日ご紹介したマクロと異なっている部分です。
まずは、選択されているスライドのSlideIndexを配列・arrに格納します。
With ActiveWindow.Selection
cnt = .SlideRange.Count
ReDim arr(1 To cnt)
For i = 1 To cnt
arr(i) = .SlideRange(i).SlideIndex
上記のようなFor～Nextループで、とりあえず格納するはできるのですが、実はこのままだと、スライドの順番がバラバラになってしまいます。
ここでSlideIndexを取得するために利用しているSledeRangeオブジェクトは、選択されているものを表すSelectionオブジェクトに含まれるために、PowerPointで選択した順番が影響を与えてしまうためです。
そのため、SlideIndexの昇順になるように配列の要素を並べ替えています。
For x = LBound(arr) To UBound(arr) - 1
For y = x + 1 To UBound(arr)
If arr(x) > arr(y) Then
tmp = arr(x)
arr(x) = arr(y)
arr(y) = tmp
End If
Next y
Next x
Home » パワーポイントマクロ・PowerPoint VBAの使い方 » Slide・スライド » 選択されているスライドをコピーして新しいプレゼンテーションを作成するパワポマクロ
