フォルダ内にあるpptファイルのページ数を数えるExcelマクロです。Folderにフォルダパスを渡し、StartRangeに結果の挿入開始位置を渡します。StartRangeから下向きに、ファイル名とページ数を記録していき、最後に合計値を計算します。
Private Sub CountPPTFilePageInFolder(Folder As String, StartRange As Range) If FS.FolderExists(Folder) = False Then MsgBox Folder + " フォルダが見つかりません。" Exit Sub End If Dim Filename As String Dim Count As Integer Filename = Dir(FS.BuildPath(Folder, "\*.ppt*"), vbNormal) If Filename = "" Then MsgBox "PowerPointファイルが見つかりません" Exit Sub End If Dim R As Range Set R = StartRange ' PowerPointアプリを作成 Dim pptApp As Object Set pptApp = CreateObject("PowerPoint.Application") Do While Filename <> "" ' PowerPointファイルを開く Dim pptFile As Object Set pptFile = pptApp.presentations.Open(FS.BuildPath(Folder, Filename), WithWindow:=msoFalse) ' ページ数を数える Count = pptFile.Slides.Count pptFile.Close R.Value = Filename R.Cells(1, 2).Value = Count Set R = R.Offset(1, 0) Filename = Dir() Loop ' 合計値 Dim SumRange As Range Set SumRange = R.Offset(0, 1) SumRange.Formula = "=SUM(" & StartRange.Offset(0, 1).Address & ":" & SumRange.Offset(-1, 0).Address & ")" ' PowerPointアプリを終了 pptApp.Quit End Sub
呼び出し例。
Public Sub UpdatePPTFilePageCount() Dim Folder As String ' A1にフォルダパスを記述 Folder = Range("A1").Text ' シートをクリア Me.Cells.Clear Range("A1").Value = Folder ' A2から結果を出力 Dim R As Range Set R = Range("A2") ' PPTのページ数カウント CountPPTFilePageInFolder Folder, R MsgBox "完了!" End Sub