Home » パワーポイントマクロ・PowerPoint VBAの使い方 » Slide・スライド » 選択されているスライドをコピーして新しいプレゼンテーションを作成するパワポマクロ

選択されているスライドをコピーして新しいプレゼンテーションを作成するパワポマクロ

対象:PowerPoint2007, PowerPoint2010, PowerPoint2013

配列変数に指定されたスライドをコピーして新しいプレゼンテーションファイルを作成するPowerPointマクロをご紹介しました。

レポーティング業務などで、定期的に毎回同じスライドでダイジェスト版を作るような場合は、この配列に事前に指定しておくというマクロが便利だと思います。

一方で、ダイジェスト版の元にしたいスライドが、頻繁に変わるというケースもあるように思えます。

その場合、ダイジェスト版を作りたいスライドをPowerPoint上で選択しておいてから実行するマクロのほうが便利かもしれません。

そんなPowerPointマクロを作ってみました。

[スポンサードリンク]

選択されているスライドをコピーして新規プレゼンテーションファイルを作成するサンプルマクロ

ダイジェスト版に流用したいスライドだけを選択しておいてから、以下のマクロを実行すると、選択されていたスライドのみを含んだ新しいプレゼンテーションファイルが作成されます。

Sub 選択されているスライドを流用して新しいプレゼンテーションファイルを作成する()

 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

関連語句
VBA, Visual Basic for Applications
[スポンサードリンク]

Home » パワーポイントマクロ・PowerPoint VBAの使い方 » Slide・スライド » 選択されているスライドをコピーして新しいプレゼンテーションを作成するパワポマクロ

「Slide・スライド」の記事一覧

検索


Copyright © インストラクターのネタ帳 All Rights Reserved.

.