ページ数を取得するVBA

Excelのページ数をテキストに出力するVBA。
ただし、改ページの設定によっては若干の誤差が発生することがある。

'--------------------------------------------------------------------------------------
'
'	Excel ページ数を取得するスクリプト
'			(指定したフォルダにあるExcelのページ数を取得するスクリプト)
'	
'	注意点	スクリプト実行前にすべてのExcelアプリケーションを終了してください。
'			スクリプト実行中はマウス、キーボードを使用しないでください。
'			このスクリプトが異常終了した場合はExcelのプロセスを手動で終了してください。
'
'--------------------------------------------------------------------------------------

targetPath = InputBox("ページ数を取得するディレクトリを入力","ディレクトリの指定","")

if targetPath = "" then
	
	msgbox "設定を中止しました。"

else

	Dim cntHBreak
	Dim cntVBreak
	Dim cntPage

	'このディレクトリのファイル一覧を取得する
	Set fileSystem   = CreateObject("Scripting.FileSystemObject")
	Set targetFolder = fileSystem.getFolder(targetPath)
	Set fileList = targetFolder.Files

	'結果を出力するファイルを作成する
	Set resultfile = fileSystem.CreateTextFile(targetPath & "\" & "result.txt",True)

	'ファイルの終端までループ
	For Each wkFile In fileList

		'対象ファイルがExcelならExcelで開く
		if wkFile.type = "Microsoft Excel ワークシート" then

			Set Excel  = CreateObject("Excel.Application")

			Set wkBook = Excel.WorkBooks.Open(wkFile)
			
			'シートの数ループする
			For i = 1 to wkBook.WorkSheets.Count

				cntHBreak = wkBook.WorkSheets(i).HPageBreaks.Count    '横の改ページ数取得
				cntVBreak = wkBook.WorkSheets(i).VPageBreaks.Count    '縦の改ページ数取得

				'縦の改ページ=0の場合
				If cntVBreak = 0 Then
					cntPage = cntHBreak + 1
				'横の改ページ=0の場合
				ElseIf cntHBreak = 0 Then
					cntPage = cntVBreak + 1
				Else
					cntHBreak = cntHBreak + 1
					cntVBreak = cntVBreak + 1
					cntPage = cntHBreak * cntVBreak
				End If

				'結果をテキストに出力(Book & Sheet & ページ数)
				resultfile.WriteLine wkBook.Name & vbTab & wkBook.WorkSheets(i).Name & vbTab & cntPage
			Next

			'Excelを終了する。
			wkBook.Save
			wkBook.Close
			Excel.Quit

		end if

	Next

	msgbox "出力を完了しました。"

end if

動作確認環境:Windows XP sp2,Excel 2003