Excelの印刷ページ数を取得する VBAメモ
指定したフォルダ配下のファイル一覧を取得し、Excelファイルなら印刷ページ数を取得する。
参考サイト
http://d.hatena.ne.jp/asuka0801/20110605/1307232920
http://www.moug.net/tech/exvba/0150117.html
Dim cnt As Long Dim pageCount As Integer Dim xlApp As Excel.Application Dim objBooks As Excel.Workbooks Dim sh As Excel.Worksheet Sub test() Set xlApp = New Excel.Application Set objBooks = xlApp.Workbooks cnt = 0 Application.ScreenUpdating = False With Application.FileDialog(msoFileDialogFolderPicker) If .Show = True Then FolderSearch .SelectedItems(1) If Not objBooks Is Nothing Then objBooks.Close 'Excelを閉じる If Not xlApp Is Nothing Then xlApp.Quit End If End With Application.ScreenUpdating = True Set sh = Nothing Set objBooks = Nothing Set xlApp = Nothing End Sub Public Sub FolderSearch(Path As String) Dim objBook As Excel.Workbook Dim buf As String, f As Object buf = Dir(Path & "\*.*") Do While buf <> "" 'SVN管理ファイルやWindows管理ファイルを無視する If InStr(buf, "svn") = 0 And InStr(buf, "Thumbs") = 0 Then cnt = cnt + 1 Cells(cnt, 1) = Path & "\" & buf pagecnt = 0 pos = InStrRev(buf, ".") 'xls、xlsx等のファイルを対象とする 'xls123等のファイルがない前提 If LCase(Mid(buf, pos + 1)) Like "xls*" Then Set objBook = objBooks.Open( _ Filename:=Path & "\" & buf, _ UpdateLinks:=False, _ ReadOnly:=True, _ IgnoreReadOnlyRecommended:=True) For Each sh In objBook.Sheets '非表示シートは印刷ページカウント対象としない If sh.Visible = True Then sh.Select ActiveWindow.View = xlPageBreakPreview pagecnt = pagecnt + xlApp.ExecuteExcel4Macro("get.document(50)") End If Next 'Workbookを閉じる If Not objBook Is Nothing Then objBook.Saved = True If Not objBook Is Nothing Then objBook.Close End If Cells(cnt, 2) = pagecnt End If buf = Dir() Loop Set objBook = Nothing With CreateObject("Scripting.FileSystemObject") For Each f In .GetFolder(Path).SubFolders Call FolderSearch(f.Path) Next f End With End Sub