「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
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
コメント