マクロでシートのページ数を求める

Pocket

「HPageBreaks.Count」を使うと水平方向の改ページの数が分かります。ページ数はこれに1を加えた数です。
「VPageBreaks.Count」を使うと同様に垂直方向の改ページ、ページの数が分かります。
総ページ数は水平方向と垂直方向のページ数の積で表わされます。
たとえば現在のシートのページ数は次のように求められます。

thispage = (ActiveSheet.HPageBreaks.Count + 1) * (ActiveSheet.VPageBreaks.Count + 1)

ただし「次のページ数に合わせて印刷」など拡大縮小印刷を使っていると正しい値にならないことがあります。
正確な値を求めるには工夫の余地があるようですが、目安としては充分でしょう。

応用として次のような使い方を紹介します。
以前、フォルダ内のファイルとシートの名前を列挙するマクロを紹介しました。
これにシートのページ数を表示する機能を付け加えてみました。

Sub シート一覧の作成()
    Dim fn(1000)
    Dim sn(10000, 10)
    'フォルダの選択
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "フォルダを選択"
        .AllowMultiSelect = False
        If .Show = -1 Then
            mypath = .SelectedItems(1) & ""
        Else
            Exit Sub
        End If
    End With
    'ファイル名の取得
    fn(1) = Dir(mypath, vbDirectory)
    i = 1
    Do
        i = i + 1
        fn(i) = Dir
    Loop Until fn(i) = ""
    'シート名の取得
    x = 0
    For j = 1 To i - 1
        ext = Mid(fn(j), InStrRev(fn(j), ".") + 1, 3)
        If ext = "xls" Then
            Workbooks.Open Filename:=fn(j)
            For k = 1 To Sheets.Count
                sn(x, 1) = fn(j)
                sn(x, 2) = Sheets(k).Name
                sn(x, 3) = (Sheets(k).HPageBreaks.Count + 1) * (Sheets(k).VPageBreaks.Count + 1)
                x = x + 1
            Next k
            ActiveWorkbook.Close
        End If
    Next j
    'シート一覧の作成
    Cells.ClearContents
    Cells(1, 1) = mypath
    Cells(3, 1) = "ファイル名"
    Cells(3, 2) = "シート名"
    Cells(3, 3) = "ページ数"
    x = 0
    Do
        Cells(x + 4, 1) = sn(x, 1)
        Cells(x + 4, 2) = sn(x, 2)
        Cells(x + 4, 3) = sn(x, 3)
        x = x + 1
    Loop Until sn(x, 1) = ""
End Sub

[ 2014年6月2日 | カテゴリー: Excel | タグ: , ]

« | »

コメントを残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です

送信してください。


タグ

カテゴリー

最近の投稿

最近のコメント

固定ページ

アーカイブ

stabucky

写真

メタ情報