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 アドイン

    Ignite 2016で発表されたOffice アドイン関連の情報

    米国時間の9月26~30日にMicrosoftのビッグイベント「Ign…

  2. Office関連

    「Excel VBAでIEを思いのままに操作できるプログラミング術」の見本誌をいただきました。

    「VBAアクションゲーム?Excel(エクセル)で動かそう!」で有名な…

  3. Office関連

    MicrosoftのDictateアドインを試してみました。

    Microsoftがハンズフリー入力をサポートするOffice用(Wo…

  4. アイコン一覧

    Office 365アイコン(imageMso)一覧(G)

    Office 365のデスクトップ版Officeアプリケーション(Wo…

  5. Office関連

    Excel 2013 新関数一覧

    「関数一覧(Excel 2010)」と「関数一覧(Excel 2013…

  6. Office関連

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

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

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

Translate

最近の記事

アーカイブ

PAGE TOP