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関連

    文字列を指定した文字数で分割するVBA関数

    "01234567890123456789012…"というような長い文…

  2. Office関連

    PDFファイルにヘッダーとフッターを追加するVBAマクロ

    mougに“マクロで既存のPDFファイルのフッターを操作(追加)したい…

  3. Office関連

    「Excel VBAでラクラク Win64 APIプログラミング」(大村あつし著)レビュー

    当ブログでも以前書評を書いた「Excel VBAの神様 ボクの人生を変…

  4. Office関連

    「もし宇宙人が地球レポートをまとめたら」動画公開

    PLAY! Office第三弾、「もし宇宙人が地球レポートをまとめたら…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

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

Translate

最近の記事

アーカイブ

PAGE TOP