小人さんのメモ

オンラインノートとして利用しています。

ゲームを加速させるイメージビルダー

スクショの一覧集を作成するのに有効なパワポマクロを作成し、利用しました。皆様もご利用ください。

現在のプロゲーマーにはスクショとその集約作成はマストスキルです。
最もゲーミングに適したWindowsと標準のスナッピングツールの利用を想定し、PNGを対象としました。

 

 

ファイル

URLを追記。

 

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
      'PNGファイルのみ処理
      Select Case LCase(.GetExtensionName(f.Path))
        Case "png"
          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

 

 

余談

steam deckなどカスタムLinuxが普及し、LinuxLibreOfficeのImpressなど扱う機会があれば、デバッグのコード改変含めてトライします。

 

では、enjoy!