VBAでページ番号をつける

指定したエクセルファイルのページごとに通番をつけていくマクロ。複数のファイルに連番をつけたい時はこのマクロを使えばいい。

その他応用も可能なのでテンプレートに使用できる。

このマクロができること

• ページ付与機能
• ページ整形機能

ソース一部抜粋

'連番で複数ファイルにページ番号を付与する'分類を利用して作成しておくSub ページ番号付与実行()

  Application.DisplayAlerts = False

  処理続行確認メッセージ

  Dim RowNum As Integer  Dim TotalPageNum As Integer  TotalPageNum = 0

  '設定シート読込みループ  For RowNum = 5 To ActiveSheet.Cells.SpecialCells(xlLastCell).Row

    '設定取得    エクセル文書整形設定取得 (RowNum)

    If FilePath = "" Then      MsgBox "おわったよー", vbInformation, "終了"      Exit For    End If

    Dim IsChange As Boolean    IsChange = False

    If ClassA <> ClassABefore Or ClassB <> ClassBBefore Then      '大分類、中分類が変わった時      IsChange = True

      If StartNum <> 0 And StartNum <> 1 Then        '開始番号が指定されている場合はその値を利用する        TotalPageNum = StartNum - 1      Else        TotalPageNum = 0      End If    End If

    'MsgBox "StartNum=" & StartNum    'MsgBox "TotalPageNum=" & TotalPageNum

    Workbooks.Open fileName:=FilePath    Worksheets(1).Activate

    '設定する開始ページ番号を記入    ThisWorkbook.Sheets("設定").Cells(RowNum, 5).Value = TotalPageNum + 1

    'シート選択    Dim W As Worksheet    For Each W In Worksheets

      W.Select

      With ActiveSheet

        If W.Name Like TargetSheetInitial Then

          'これまでの総ページ数 + 1 を設定する          .PageSetup.FirstPageNumber = TotalPageNum + 1          .PageSetup.RightFooter = "&""MSP ゴシック""&P"

          'ヘッダの設定          ヘッダクリア

          If HeaderStr <> "" Then            .PageSetup.RightHeader = HeaderStr          End If

          'フッター設定          フッタクリア

          If ClassA = "" Then            If ClassB = "" Then              .PageSetup.RightFooter = "&""MSP ゴシック""&P"            Else              .PageSetup.RightFooter = ClassB & Sep & "&""MSP ゴシック""&P"            End If          Else            If ClassB = "" Then              .PageSetup.RightFooter = ClassA & Sep & "&""MSP ゴシック""&P"            Else              .PageSetup.RightFooter = ClassA & Sep & ClassB & Sep & "&""MSP ゴシック""&P"            End If          End If

          '総ページ数をカウントする          TotalPageNum = TotalPageNum + ページ数取得          'MsgBox "TotalPageNum=" & TotalPageNum        End If

      End With    Next W

    '総ページ数が処理後も同じならばページ番号を付与していない    If ThisWorkbook.Sheets("設定").Cells(RowNum, 5).Value - 1 = TotalPageNum Then      ThisWorkbook.Sheets("設定").Cells(RowNum, 5).Value = "-"    End If

    'ページを付与したシートを全て選択しておく    Dim W2 As Worksheet    Dim IsFirst As Boolean    IsFirst = True

    For Each W2 In Worksheets      If W2.Name Like TargetSheetInitial Then        If IsFirst Then          W2.Select True          IsFirst = False        Else          W2.Select False        End If      End If    Next W2

    '上書き保存    ActiveWorkbook.Save    ActiveWorkbook.Close

  Next RowNum

  Application.DisplayAlerts = True

  MsgBox "おわったよー", vbInformation, "終了"

End Sub