指定したフォルダ内のすべてのエクセルにフッターを挿入する関数

タイトルの関数は、以下です。

'**********************************
'* folderPath:指定したフォルダのパス
'* sheetName:コピー元のシート名
Private Sub InsertFooterInExcelFiles(ByVal folderPath As String, ByVal sheetName As String)
    
    Dim fileName As String
    Dim wbMacro As Workbook
    Dim wsSampleFooter As Worksheet
    Dim wbTarget As Workbook
    Dim wsTarget As Worksheet
    
    ' マクロブックのパス(必要に応じて変更してください)
    Set wbMacro = ThisWorkbook
    ' フッター設定をコピーするシート
    Set wsSampleFooter = wbMacro.Worksheets(sheetName)
       
    ' フォルダ内の各エクセルファイルに対して処理
    fileName = Dir(folderPath & "*.xlsx")
    Do While fileName <> ""
        ' エクセルファイルを開く
        Set wbTarget = Workbooks.Open(folderPath & fileName)
        
        ' 各シートに対してフッター設定をコピー
        For Each wsTarget In wbTarget.Worksheets
            ' 中央のフッター設定をコピー
            wsTarget.PageSetup.CenterFooter = wsSampleFooter.PageSetup.CenterFooter
            ' 左側のフッター設定をコピー
            wsTarget.PageSetup.LeftFooter = wsSampleFooter.PageSetup.LeftFooter
            ' 右側のフッター設定をコピー
            wsTarget.PageSetup.RightFooter = wsSampleFooter.PageSetup.RightFooter
        Next wsTarget
        
        '確認・警告メッセージを表示しない様に設定する。(非表示設定)
        Application.DisplayAlerts = False
        
        ' 保存して閉じる
        wbTarget.Save
        wbTarget.Close
        
        '確認・警告メッセージを表示設定に戻す。(表示設定)
        Application.DisplayAlerts = True
        
        ' 次のファイルを検索
        fileName = Dir
    Loop
End Sub

使用例は、以下です。

Private Sub 使用例()
    Call InsertFooterInExcelFiles("C:\TEMP\", "コピー元")
End Sub

引数に、フォルダとシート名を指定することが可能です。この使用例では、このマクロブックのシート「コピー元」のフッター設定を、他のシートにコピーします。他のシートは、「C:\TEMP\」に保管されている拡張子が「xlsx」のすべてファイルのすべてのシートが対象です。

Follow me!