Excelについてのセルにページ番号

質問

Excelについての質問です。
複数枚にわたるシートがあるんですがそれをフッターではなく
セルの中に自動的にページをふるように設定することって
できるのでしょうか？

回答No.3

nishi6 · ベストアンサー

複数シートは考えていませんでした。変形してみました。
下記マクロは単独、複数シートに対応しています。(しているはずです)
複数シートの場合は、１枚目のシートを選択(シート見出しをクリック)してShiftキーかCtrlキーを押しながら２枚目以降のシートを選択(同じようにシート見出しをクリック)します。各シートに渡った頁はシートの選択順にかかわらず左にあるシートから順に付けられます。色々勉強になりました。問題提起ありがとうございました！

Public Const wrtColumn = 1 '印刷範囲での書き込む列位置(左からの列数)
Public cellPage As Integer '複数シートを通しての通し番号

'選択したシートに連続番号をセットする
Public Sub SelectSheetsPageNoSet()
　　Dim sht As Worksheet 'ワークシート

　　cellPage = 0 '共通頁の初期化
　　For Each sht In ThisWorkbook.Windows(1).SelectedSheets 'ウインドウは１つ
　　　　pageNoSet_Sub sht.Name '選択シート毎に処理する
　　Next
End Sub

'頁数(- 頁 -)をセルに書き込む。印刷範囲を設定して実行する(Sheet単位)
Public Sub pageNoSet_Sub(shtName As String)
　　Dim hPB As Integer '改行位置
　　Dim cot As Integer '改行カウンタ
　　Dim rowNum As Long '印刷範囲の最終行

　　Worksheets(shtName).Activate
　　On Error GoTo ErrorHandler '印刷範囲を設定していない場合
　　With ActiveSheet
　　　　rowNum = .Range("Print_Area").Rows.Count
　　　　.Range("Print_Area").Cells(rowNum, 1).Select
　　　　hPB = .HPageBreaks.Count
　　　　　　For cot = 1 To hPB
　　　　　　　　cellPage = cellPage + 1
　　　　　　　　.HPageBreaks(cot).Location.Offset(-1, wrtColumn - 1) = "- " & cellPage & " -"
　　　　　　Next
　　　　　　cellPage = cellPage + 1
　　　　　　.Range("Print_Area").Cells(rowNum, wrtColumn) = "- " & cellPage & " -"
　　End With
　　Exit Sub
ErrorHandler:
　　If Err = 1004 Then MsgBox "印刷範囲を設定して実行して下さい"
End Sub

お礼

すごい！出来ました！
＞色々勉強になりました。問題提起ありがとうございました！
とんでもない、恐れ多いです。
マクロ、出来るとホント便利ですねぇ
あたしもこれを機会にマクロの勉強はじめてみようかな。
大変助かりました。ありがとうございました。

回答No.2

nishi6

マクロを書いてみました。縦に長い表を想定しています。これは横に長い表は対応していません。
横に長い場合は別途書き換える必要があると思います。
印刷範囲が設定してあることが条件です。挿入した改頁と自動の改頁両方をカウントしています。

１頁に収まらない場合、改行位置は自動で設定されるはずですが、画面に改行位置が見えない場合は『HPageBreaks』が正確な値を返してくれないようです。そのため、印刷範囲の最終位置(最下段)に画面を移し、『HPageBreaks』で改行の個数と位置を確定しています。

wrtColumnに印刷範囲での書き込む列位置(印刷の左端から何列目か)をセットします。

以下を標準モジュールに貼り付けます。ご参考に。

'頁数(- 頁 -)をセルに書き込む。印刷範囲を設定して実行する
Public Sub pageNoSet()
　　Const wrtColumn = 1 '印刷範囲での書き込む列位置(左からの列数)
　　Dim hPB As Integer '改行位置
　　Dim cot As Integer '改行カウンタ
　　Dim rowNum As Long '印刷範囲の最終行

　　On Error GoTo ErrorHandler '印刷範囲を設定していない場合
　　With ActiveSheet
　　　　rowNum = .Range("Print_Area").Rows.Count
　　　　'改行位置を設定するために印刷範囲の最後に移動する
　　　　.Range("Print_Area").Cells(rowNum, 1).Select
　　　　hPB = .HPageBreaks.Count
　　　　　　For cot = 1 To hPB
　　　　　　　　'改行位置の前のセルに頁を書き込む（例）
　　　　　　　　.HPageBreaks(cot).Location.Offset(-1, wrtColumn - 1) = "- " & cot & " -"
　　　　　　　　'= cot & "/" & (hPB + 1)　これは頁数と総頁の例
　　　　　　Next
　　　　　　'最終頁のセルに書き込む
　　　　　　.Range("Print_Area").Cells(rowNum, wrtColumn) = "- " & cot & " -"
　　　　　　'= cot & "/" & (hPB + 1)　これは頁数と総頁の例
　　End With

　　Exit Sub

ErrorHandler:
　　If Err = 1004 Then MsgBox "印刷範囲を設定して実行して下さい"
End Sub

お礼

回答ありがとうございます♪
やはりマクロを使わないと出来ないんですねぇ。
マクロまで書いていただいてすっごく感謝してます。
早速ためさせていただきました。
しかし、あたしの説明不足だったのと、あたしの知識不足のせいで
よく分からないのでもうひとつ質問させていただきたいのですが
このマクロは複数のシートにわたっても使用することってできるんでしょうか？

回答No.1

maje

同じような質問ありますよ↓
簡単には出来ないようです。

参考URL：

http://oshiete1.goo.ne.jp/kotaeru.php3?q=94009

お礼

早速の回答ありがとうございます。
簡単には出来ないようですね。