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 2013 アイコン一覧(B)

    ・Office 2013 アイコン一覧 NUM…

  2. Office関連

    VBAを学ぶときの参考資料

    知人から「Excelのマクロを勉強したいんだけど、どうやって勉強したら…

  3. Office アドイン

    [Officeアドイン]枠線(目盛線)の表示・非表示を切り替える方法

    ここ二週間ほど体調を崩していたので久しぶりのブログ更新です。久…

  4. アイコン一覧

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

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

  5. Office アドイン

    [Office用アプリ]マニフェストファイルをSharePointに配置する。

    今更になりますが、今回はマニフェストファイルをSharePoint上に…

  6. Office アドイン

    PowerPoint用のOffice用アプリ

    当ブログでも散々紹介しているOffice用アプリ(apps for O…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

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

Translate

最近の記事

アーカイブ

PAGE TOP