ExcelVBAでExcelのページ数を取得する(2)

前回の方法よりもっと確実な方法を見つけた
どうやらPageSetupから直接ページ数が取得出来るみたい。

Sub getPageCount()
    Dim strFile As String
    Dim intPageCount As Integer

    'ファイル指定
    strFile = "C:\test\test.xlsx"
    '関数からExcel WorkBookのページ数を取得
    intPageCount = ExcelPrintPageCount(strFile)

    MsgBox intPageCount & "ページだよ!"
End Sub

'Excelブックのページ数をカウントする
Function ExcelPrintPageCount(ByVal strFile As String) As Integer
    Dim pageCount As Integer
    Dim xlApp As Excel.Application
    Dim objBooks As Excel.workbooks
    Dim objBook As Excel.Workbook
    Dim sht As Excel.Worksheet

    Set xlApp = New Excel.Application
    'xlApp.Visible = True 'デバッグ時に使用する

    'エラー処理
    On Error Resume Next
    Set objBooks = xlApp.workbooks

    If Dir(CStr(strFile)) <> "" Then
        'Excelファイルを読み取り専用で開く
        Set objBook = objBooks.Open( _
                        Filename:=strFile, _
                        UpdateLinks:=False, _
                        ReadOnly:=True, _
                        IgnoreReadOnlyRecommended:=True)

        If Err.Number = 0 Then
            For Each sht In objBook.Worksheets
                'シートをアクティブに変更
                sht.Activate
                'ウィンドウを改ページプレビューで表示する
                xlApp.windows(Dir(strFile)).View = xlPageBreakPreview
                '印刷プレビューのページカウントを取得する
                pageCount = pageCount + CInt(sht.PageSetup.Pages.Count)
            Next sht
        Else
            'ファイルが読み取れない場合は-1をセット
            pageCount = -1
        End If
    Else
        'ファイルが存在しない場合は-1をセット
        pageCount = -1
    End If

    If Err.Number <> 0 Then
        'その他例外が発生した場合は-1をセット
        pageCount = -1
    End If

    If Not objBook Is Nothing Then
        'Workbookを閉じる
        objBook.Saved = True
        objBook.Close
    End If
    If Not objBooks Is Nothing Then
        'Workbooksを閉じる
        objBooks.Close
    End If
    If Not xlApp Is Nothing Then
        'Excelを閉じる
        xlApp.Quit
    End If

	'戻り値をセット
	ExcelPrintPageCount = pageCount

	'メモリ解放
    Set sht = Nothing
    Set objBook = Nothing
    Set objBooks = Nothing
    Set xlApp = Nothing
End Function

しかし、この方法他のExcelVBAサイトにまだ載ってないのね・・・