Office関連

指定したフォルダ内の画像ファイルを一括挿入するPowerPointマクロ

大量の画像ファイルを1枚/1スライドで挿入する必要があり、

  1. 白紙のスライドを追加し、画像ファイルを挿入する。
  2. 画像の大きさをスライドに合わせる。
  3. 画像をスライドの上下左右中央に配置する。

といった作業をいちいち手作業で行うのは面倒くさかったので、マクロを組むことにしました。

指定したフォルダ内の画像ファイルを一括挿入するPowerPointマクロ

Option Explicit

Public Sub InsertImages()
'指定したフォルダ内の画像ファイルを一括挿入
  Dim prs As PowerPoint.Presentation
  Dim sld As PowerPoint.Slide
  Dim shp As PowerPoint.Shape
  Dim tmp As PowerPoint.PpViewType
  Dim fol As Object, f As Object
  Dim fol_path As String
  
  Set prs = ActivePresentation
  
  'スライドショー表示になっていたら解除
  If SlideShowWindows.Count > 0 Then prs.SlideShowWindow.View.Exit
  
  With ActiveWindow
    tmp = .ViewType 'ウィンドウの表示モード記憶
    .ViewType = ppViewSlide
  End With
  
  '画像フォルダ取得
  Set fol = CreateObject("Shell.Application") _
            .BrowseForFolder(0, "画像フォルダ選択", &H10, 0)
  If fol Is Nothing Then GoTo Fin
  fol_path = fol.Self.Path
  
  'フォルダ内のファイル処理
  With CreateObject("Scripting.FileSystemObject")
    If Not .FolderExists(fol_path) Then GoTo Fin
    
    For Each f In .GetFolder(fol_path).Files
      'JPEGファイルのみ処理
      Select Case LCase(.GetExtensionName(f.Path))
        Case "jpg", "jpeg"
          Set sld = prs.Slides.Add(prs.Slides.Count + 1, ppLayoutBlank)
          sld.Select
          Set shp = sld.Shapes.AddPicture(FileName:=f.Path, _
                                          LinkToFile:=False, _
                                          SaveWithDocument:=True, _
                                          Left:=0, _
                                          Top:=0)
          With shp
            .LockAspectRatio = True '縦横比を固定
            
            '挿入した画像をスライドのサイズに合わせる
            If .Width > .Height Then
              .Width = prs.PageSetup.SlideWidth
            Else
              .Height = prs.PageSetup.SlideHeight
            End If
            
            .Select
          End With
          
          '画像をスライド中央に配置
          With ActiveWindow.Selection.ShapeRange
            .Align msoAlignCenters, True
            .Align msoAlignMiddles, True
          End With
      End Select
    Next
  End With
Fin:
  ActiveWindow.ViewType = tmp 'ウィンドウの表示モードを元に戻す
End Sub

上記マクロを実行すると、ダイアログから選択したフォルダ内にあるJPEGファイルを、一括でスライドに挿入します。

PaintsChainerでオトカドールのぬりえに着色してみたよ。前のページ

フッターにページ番号と総ページ数を挿入するWordマクロ次のページ

関連記事

  1. Office関連

    [PowerPoint]シェイプの名前を指定して「変形」ができるようになりました。

    PowerPoint 2016で新しい画面切り替え効果「変形」が追加さ…

  2. Office関連

    [リボン・カスタマイズ]splitButton要素で大量にある項目を使いやすくまとめる。

    「既存の機能の代わりにマクロを実行する」でコメント(下記)をいただきま…

  3. Office関連

    「クラシックスタイルメニュー」の誤検知?

    2013/07/16 追記:cx20さんにコメントで"Google…

  4. Office関連

    Gmail APIを使ってメール送信するVBAマクロ

    「「Gmail API」β版公開、連動アプリ開発を支援」にもあるように…

  5. Office関連

    Excelを使わずにCSVからExcelファイルに変換するPowerShellコード

    CSVファイルからExcelファイルに変換する処理を自動化したい、Ex…

コメント

  • コメント (0)

  • トラックバックは利用できません。

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP