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

A 回答 (3件)

複数シートは考えていませんでした。

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

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 'ウインドウは1つ
    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
    • good
    • 0
この回答へのお礼

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

お礼日時:2001/09/18 09:59

マクロを書いてみました。

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

1頁に収まらない場合、改行位置は自動で設定されるはずですが、画面に改行位置が見えない場合は『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
    • good
    • 0
この回答へのお礼

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

お礼日時:2001/09/17 10:26

同じような質問ありますよ↓


簡単には出来ないようです。

参考URL:http://oshiete1.goo.ne.jp/kotaeru.php3?q=94009
    • good
    • 0
この回答へのお礼

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

お礼日時:2001/09/17 10:05

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人が検索しているワード


このカテゴリの人気Q&Aランキング

おすすめ情報

カテゴリ