Excelで複数のファイルのすべてのシートのヘッダを操作

Pocket

大量の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

ヘッダをセットする

次にヘッダをセットします。
ヘッダだけでなく、フッタにも対応できるようにしておきます。ヘッダとフッタ、それぞれ左、中央、右とありますので、全部で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

全体を実行する

すべてのファイル名を取得します。一つ目のファイルを開きます。
ヘッダをセットします。ここでは三番目の引数、右ヘッダに「マル秘」を入力します。
ファイルを保存して閉じます。
次のファイルがあれば開き、繰り返します。

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

この例ではヘッダとフッタは単純に上書きしてしまいます。
あらかじめセットしてあれば、上書きしないとか、別の箇所にセットするとか、文字列をマージするとか、工夫できるかもしれません。

[ 2010年9月18日 | カテゴリー: Excel | タグ: ]

« | »

コメントを残す

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

送信してください。


タグ

カテゴリー

最近の投稿

最近のコメント

固定ページ

アーカイブ

stabucky

写真

メタ情報