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