【VBA】配下全てのエクセルにヘッダーとページ番号を設定する

こんにちは。
今回は、前回までの記事を参考に
指定した起点のフォルダ配下のすべての
エクセルにヘッダーとページ番号を設定するサンプルです。

概要

サンプルではマクロの置いてある場所を起点のパスとしています。
流れは以下。

スタート
→ 対象のフォルダをすべて抽出する
→ 拡張子が「xlsx」のファイル検索
→ ブックをオープンしてすべてのシートを取得して回る
→ 「ブック名＋シート名」のヘッダーとページ番号を設定

各処理の詳細につきましては、以下の記事参照。

【VBA】配下のフォルダ一覧を取得する - なんだかGoodVibes

【VBA】フォルダ内のエクセル一覧を取得する - なんだかGoodVibes

【VBA】ブックのシート一覧を取得する - なんだかGoodVibes

ソース

Option Explicit

Private TaishoFolderArr() As String

' --------------------------------------------------
' メイン
' --------------------------------------------------
Sub Main()

    ' 初期値の取得
    Dim path As String
    path = ThisWorkbook.path
    ReDim TaishoFolderArr(0)

    On Error GoTo ErrorResult
    Call GetTaishoFolder(path)

    If UBound(TaishoFolderArr) > 0 Then
        ReDim Preserve TaishoFolderArr(UBound(TaishoFolderArr) - 1)
    End If

    Call SearchFile

    MsgBox "完了しました。"
    Exit Sub

ErrorResult:
    MsgBox "エラーが発生しました。"

End Sub

' --------------------------------------------------
' 配下のサブフォルダを取得します。
' --------------------------------------------------
Private Sub GetTaishoFolder(ByVal path As String)

    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim objFolder As Object
    Set objFolder = fso.GetFolder(path)

    TaishoFolderArr(UBound(TaishoFolderArr)) = path
    ReDim Preserve TaishoFolderArr(UBound(TaishoFolderArr) + 1)

    Dim f As Object
    For Each f In objFolder.SubFolders
       Call GetTaishoFolder(path & "\" & f.name)
    Next f

    Set fso = Nothing

End Sub

' --------------------------------------------------
' 各フォルダ内のエクセルを探してチェック開始します。
' --------------------------------------------------
Private Sub SearchFile()

    Dim i As Long: i = 0
    Dim path As String
    For i = 0 To UBound(TaishoFolderArr)
        path = TaishoFolderArr(i)

        Dim buf As String
        buf = Dir(path & "\", vbDirectory)
        Do While buf <> ""
            If InStr(buf, ".xlsx") <> 0 Then
                Call EditWorkbook(path, buf)
            End If

            buf = Dir()
        Loop
    Next i

End Sub

' --------------------------------------------------
' ヘッダーとページ番号を設定します。
' --------------------------------------------------
Private Sub EditWorkbook(ByVal path As String, ByVal name As String)

    Application.ScreenUpdating = False

    ' ----- ブックオープン -----
    Dim taishoBkName As String: taishoBkName = Replace(name, ".xlsx", "")
    Dim taishoFullPath As String: taishoFullPath = path & "\" & name
    Workbooks.Open taishoFullPath
    ThisWorkbook.Activate

    Dim taishoBk As Workbook
    Set taishoBk = Workbooks(name)

    ' ----- シートを取得する -----
    Dim taishoWs As Worksheet
    For Each taishoWs In taishoBk.Sheets

        ' ヘッダーとページ番号の設定
        With taishoWs.PageSetup
            .LeftHeader = taishoBkName & "   " & taishoWs.name
            .CenterFooter = "&P/&N"
        End With

    Next taishoWs

    ' ダイアログを出さないようにする
    Application.DisplayAlerts = False
    taishoBk.Close SaveChanges:=True
    Application.DisplayAlerts = True
    
    Application.ScreenUpdating = True
End Sub

まとめ

沢山作ったエクセルをまとめて編集したいときって結構あるかと思います。
このサンプルでは起点のフォルダ配下のファイルをすべて編集することができます。
今回は、ヘッダーとページ番号の設定ですが、
この処理を変えるだけで一括で必要な修正・チェックができちゃいます。
非常に便利なのでみなさんも参考にしてみてください。
以上です。