指定したフォルダ内のすべてのエクセルにフッターを挿入する関数
タイトルの関数は、以下です。
'**********************************
'* 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」のすべてファイルのすべてのシートが対象です。