[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列に入力されたファイルのフッターがすべて、右下「株式会社〇〇」となる。

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です