2011-06-05

こまめに修正が入るドキュメント類のページ数を、わざわざ手動で数えるのが面倒なので手っ取り早くExcelのVBAマクロで取得する方法がないか調べてみました。

ちなみに、当方の環境は以下の通りです。

OS:Windows7 Ultimate x32
Office:Office Professional 2010
Office:Office Professional 2007

Officeは一応2007と2010で動作確認してます。

まずGoogle先生に質問して出てくるのはここら辺ですね。

    H_Break = Sheet1.HPageBreaks.Count    '横の改ページ数取得
    V_Break = Sheet1.VPageBreaks.Count    '縦の改ページ数取得

VPageBreaks.Count、HPageBreaks.Countで縦横の改ページ数を取得出来るみたいですが、このサンプルでは
こんな感じ

な場合に上手く取得出来なかったりします。
他にも何個かのファイルで試してみましたが『VPageBreaks.Count』の数値自体、改ページプレビューになってないファイルのページ数を上手く取得出来なかったりして、これでマクロ組むのはちょいと面倒そうなのでパス。

お次はこれ

Sub PrintPage()
    Dim PPage As Integer
    Sheets("sheet1").Select
    PPage = Application.ExecuteExcel4Macro("get.document(50)")
    MsgBox PPage
End Sub

なるほど、Excel4Macroを使ってページ数を取得するんですね。
という訳でちょっと組んでみました。

'Excelファイルのページ数を取得する。(メイン)
Sub getPageCount()
    Dim xlApp As Excel.Application
    Dim objFileNameList As Variant
    Dim strFile As Variant
    Dim intPageCount As Integer
    Dim strOut As String

    '制御用Excelアプリケーションインスタンス生成
    Set xlApp = ActiveWindow.Application
    'ファイルを選択
    objFileNameList = selectFileProp(xlApp)

    For Each strFile In objFileNameList
        'Excel WorkBookのページ数を取得
        intPageCount = ExcelPrintPageCount(CStr(strFile))
        strOut = strOut & CStr(intPageCount) & "ページだよ!" & vbCrLf
    Next

    Set xlApp = Nothing
    
    MsgBox strOut
End Sub


'ファイル選択用のウィンドウを立ち上げる
Function selectFileProp(ByRef xlApp As Excel.Application) As Variant
    Dim objFileNameList As Variant

    objFileNameList = xlApp.GetOpenFilename( _
                        FileFilter:="Microsoft Excelブック,*.xls*", _
                        MultiSelect:=True, _
                        Title:="ページ数をカウントするファイルを選択(複数選択可)")
    
    'ファイル名読込キャンセル判定
    If Not IsArray(objFileNameList) Then
        Set xlApp = Nothing
        End 'キャンセルした場合は処理終了
    End If

    '戻り値設定
    selectFileProp = objFileNameList
End Function

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

    'xlApp.Visible = True 'デバッグ用

    On Error Resume Next
    'Excelファイルを読み取り専用で開く
    Set objBook = objBooks.Open( _
                        Filename:=strFile, _
                        UpdateLinks:=False, _
                        ReadOnly:=True, _
                        IgnoreReadOnlyRecommended:=True)
                
    For Each sht In objBook.Worksheets
        'シート選択
        sht.Select
        'ページ数を取得にゃー
        pageCount = pageCount + xlApp.ExecuteExcel4Macro("get.document(50)")
    Next sht
    
    'ファイルが読み取れない場合はページ数に-1を指定
    If Err.Number <> 0 Then pageCount = -1
    
    '戻り値設定
    ExcelPrintPageCount = pageCount

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

    Set sht = Nothing
    Set objBook = Nothing
    Set objBooks = Nothing
    Set xlApp = Nothing
End Function

おお！いいんじゃないですか？

ただ、get.document(50)は改ページプレビューしていないファイルや、ページレイアウトで「縦1ページ×横1ページ」を指定している場合上手く所得できないみたい？
もう少し改良が必要ですね。

ぶらてるついん

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