Excelで複数のファイルのすべてのシートのヘッダを操作
大量のExcelファイルの全てのシートのヘッダに「マル秘」という文字列をセットすることになりました。
面倒なのでマクロを使います。
ファイル名を取得する
対象となるExcelファイルを適当なフォルダにまとめます。
そのフォルダ内のファイル名をすべて取得します。
結果は配列として返ります。
Function get_filenames()
Dim ars(99)
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "フォルダを選択"
.AllowMultiSelect = False
If .Show = -1 Then
mypath = .SelectedItems(1) & ""
Else
Exit Function
End If
End With
ars(0) = Dir(mypath)
i = 0
Do
i = i + 1
ars(i) = Dir()
Loop Until ars(i) = ""
get_filenames = ars
End Function
Dim ars(99)
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "フォルダを選択"
.AllowMultiSelect = False
If .Show = -1 Then
mypath = .SelectedItems(1) & ""
Else
Exit Function
End If
End With
ars(0) = Dir(mypath)
i = 0
Do
i = i + 1
ars(i) = Dir()
Loop Until ars(i) = ""
get_filenames = ars
End Function
ヘッダをセットする
次にヘッダをセットします。
ヘッダだけでなく、フッタにも対応できるようにしておきます。ヘッダとフッタ、それぞれ左、中央、右とありますので、全部で6か所を指定します。
開いているファイルのすべてのシートについて実行します。
Function set_header_footer(lh, ch, rh, lf, cf, rf)
For Each ws In Worksheets
With ws.PageSetup
.LeftHeader = lh
.CenterHeader = ch
.RightHeader = rh
.LeftFooter = lf
.CenterFooter = cf
.RightFooter = rf
End With
Next
End Function
For Each ws In Worksheets
With ws.PageSetup
.LeftHeader = lh
.CenterHeader = ch
.RightHeader = rh
.LeftFooter = lf
.CenterFooter = cf
.RightFooter = rf
End With
Next
End Function
全体を実行する
すべてのファイル名を取得します。一つ目のファイルを開きます。
ヘッダをセットします。ここでは三番目の引数、右ヘッダに「マル秘」を入力します。
ファイルを保存して閉じます。
次のファイルがあれば開き、繰り返します。
Sub set_all()
fns = get_filenames()
For Each fn In fns
If fn <> "" Then
Workbooks.Open Filename:=fn
Call set_header_footer("", "", "マル秘", "", "", "")
ActiveWorkbook.Save
ActiveWindow.Close
End If
Next fn
End Sub
fns = get_filenames()
For Each fn In fns
If fn <> "" Then
Workbooks.Open Filename:=fn
Call set_header_footer("", "", "マル秘", "", "", "")
ActiveWorkbook.Save
ActiveWindow.Close
End If
Next fn
End Sub
この例ではヘッダとフッタは単純に上書きしてしまいます。
あらかじめセットしてあれば、上書きしないとか、別の箇所にセットするとか、文字列をマージするとか、工夫できるかもしれません。
[ 2010年9月18日 | カテゴリー: Excel | タグ: VBA ]
« Excelでシートを隠す方法 | Wordマクロで選択範囲内だけ置換するときの注意 »
コメントを残す