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

    セル内の改行をカウントするExcelマクロ

    「Excel セルの内容 改行を数える VBA」といったキーワード検索…

  2. アイコン一覧

    Office 2013 アイコン一覧(I)

    ・Office 2013 アイコン一覧 NUM…

  3. Office関連

    「印刷の向き」の変更を検知するExcelマクロ

    MSDNフォーラムに「「印刷の向き」の「縦」「横」ボタンがクリックされ…

  4. アイコン一覧

    Office 2013 アイコン一覧(G)

    ・Office 2013 アイコン一覧 NUM…

  5. Office関連

    各スライドに配置されたオートシェイプからテキストを取得するPowerPointマクロ

    各スライドに配置されたオートシェイプからテキストを抜き出す処理を考えて…

コメント

  • コメント (0)

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

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

Time limit is exhausted. Please reload CAPTCHA.

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

Translate

最近の記事

アーカイブ

PAGE TOP