twataの備忘録

仕事、読書、ガジェット、グルメ、写真、旅行など雑多な備忘

【Excel】【VBA】複数のファイル、シートのヘッダー、フッターを一括で変更するマクロ

VBAからヘッダー、フッターを操作するには、シートオブジェクトのPageSetupオブジェクトを操作する。 例

Public Sub Main()
 ' 中央ヘッダーに「〇〇仕様書」という文字列を挿入
 WorkSheets("Sheets1").PageSetup.CenterHeader = "〇〇仕様書"
 ' 右下フッターに「株式会社〇〇」という文字列を挿入
 WorkSheets("Sheets1").PageSetup.RightFooter = "株式会社〇〇"
End Sub

指定したファイルの全シートに対して、フッターを差し替えなければ行けないということになったので、以下のようなマクロを作った。 前提条件として、対象ファイルのフルパスを取得し、A列に入力してあるものとする。

Sub changefoot()

    Dim book As Workbook
    Dim ws As Worksheet
    
    Dim file As String     ' ファイル名(フルパス)
    Dim filename As String ' ファイル名
    Dim tmp As Variant
    
    Dim Row As Long
   ' リストの先頭から最後まで繰り返す
    For Row = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        ' ファイル名を取得
        file = Cells(Row, 1).Value
        
       ' フルパスからファイル名を抽出
        tmp = Split(file, "¥")
        filename = tmp(UBound(tmp))
        
       ' ファイルをオープンする
        Workbooks.Open (file)
        
       ' オープンしたブックをアクティブにする
        Set book = Workbooks(filename)
        
       ' 保存時の警告を非表示にする
        book.CheckCompatibility = False
        
       'すべてのシートに対して操作を行う。
        For Each ws In book.Worksheets
           ' フッターの設定
            ws.PageSetup.LeftFooter = ""
            ws.PageSetup.CenterFooter = ""
            ws.PageSetup.RightFooter = "株式会社〇〇"
        Next
        
       '保存して閉じる
        Workbooks(filename).Close SaveChanges:=True
        
    Next
    
End Sub

実行結果は、A列に入力されたファイルのフッターがすべて、右下「株式会社〇〇」となる。