複数のExcelファイルの、ヘッダーをまとめて削除

VBA

新リハビリシステム導入から1か月経過しました。大きな問題ないものの、細かな変更要望がいくつか出てきています。しかしながら、初期サポートがそろそろ終わりになりますので、カスタマイズするまでもない部分は、現場である程度工夫したいところです。そこでExcelVBAの出番です。今回は出力されたExcelデータの不要部分（今回はヘッダー）を一気に削除するコードを組んでみました。

キモとなる、ヘッダー消去を行うコードは以下の通り。

Sub HeaderClear(myFName As String)

    'ファイルネームがなければ、ダイアログより入力する
    If myFName = "" Then
        myFName = SelectFile()
    End If
    
    '該当ファイルの、ヘッダー右側をクリアーする
    Workbooks.Open (myFName)
    With ActiveWorkbook
        .ActiveSheet.PageSetup.RightHeader = ""
        .Save
        .Close
    End With
    
End Sub

ヘッダーを消すのは、該当するオブジェクトさえ分かれば難しくない。
1行でこと足りる。

ActiveWorkbook.ActiveSheet.PageSetup.RightHeader = ""

他のコードから呼び出すために作ったが、単体で起動させても動く。引数なしで呼び出せば、ファイル選択のダイアログが開く。

ファイル名を取得するSelectFile()は以下の通り。

Function SelectFile() As String

    With Application.FileDialog(msoFileDialogFilePicker)
        If .Show = True Then
            SelectFile = .SelectedItems(1)
        Else
            SelectFile = ""
        End If
    End With
    
End Function

ファイル名取得だけであれば、以下の命令で十分可能です。

Application.GetOpenFilename()

しかし、FileDialogを使うと、ファイルだけでなくフォルダ名取得も簡単に行えるので、こちらを使ったほうが使いやすそう。ただし、FileDialogはExcel2000以前では使えないようなので、バージョンの確認が必要となる。Excel2002以降なら、この命令１つ覚えとけばいいだろう。

ここまでできれば、コア部分はほぼ完成。あとは使い勝手がいいように機能を加えていくだけ。まずは汎用性が高いように、フォームから操作できるようにする。
f:id:Hanamaru:20140202022217j:plain
複数ファイルを一括で処理したいので、ボタンよりフォルダ選択ダイアログを出す。

Private Sub Bn_FolderSelect_Click()

    PathString = SelectDir() & "\"
    myFName = Dir(PathString, vbNormal)
    With Lst_FName
        Do While Len(myFName) > 0
            .AddItem myFName
            myFName = Dir()
        Loop
    End With
    
End Sub

フォルダの中のファイル名を、Dir関数を使って１つずつ読み出し、リストに加える。
SelectDir()は以下の通り。上に出てきたSelectFile()とコードはほとんど同じ。

Function SelectDir() As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            SelectDir = .SelectedItems(1)
        Else
            SelectDir = ""
        End If
    End With

End Function

リストは、フォーム読み出し時に、複数選択できるよう設定する。

Private Sub UserForm_Initialize()

    Lst_FName.MultiSelect = fmMultiSelectMulti

End Sub

日付消去ボタンには、以下のコードを書く。

Private Sub Bn_DateDelete_Click()

    Dim i As Long
    Dim myFName As String

    'ヘッダー消去が視覚的に分かるよう、ウィンドウを表示する
    Application.Visible = True
    
    '選択されているファイル名を引数に、HeaderClear()を呼び出し
    With Lst_FName
        For i = 0 To .ListCount - 1
            If .Selected(i) = True Then
                Call HeaderClear(PathString & .List(i, 0))
            End If
        Next i
    End With

    '再度ウインドウを非表示にする
    Application.Visible = False

End Sub

このフォーム操作時にはExcelのシートは不要なので、起動時にシートを隠していますが、ヘッダー消去が視覚的に分かるよう、この部分では一時的にシートを表示しています。そして選択されているファイル名を引数にして、HeaderClear()を呼び出し、該当ブックを起動してヘッダーを消去しています。

ここまでで、フォルダ内のファイルを任意選択し、一括でヘッダー消去ができるようになりました。本当はこれと同時に、選択されたプリンタトレイで印刷もしたかったのですが、これはVBAだけではちょっと難しく、API駆使しなければだめそうなので、今回は断念しました。これだけでも結構作業は楽になると思うんだけど。

Dir 関数
“Dir 関Dir 関数を初めて呼び出すときは、PathName を指定する必要があります。[VBA]次の項目を取得する場合は、Dir 関数をパラメータを指定せずに続けて呼び出します。
Office TANAKA - Excel VBA Tips[フォルダを選択するダイアログ]
FileDialogを使う方法の他、SHellやAPIを使う方法が紹介。FileDialogが一番シンプルでいいが、Excel2000までは使えない。Excel2002以降は、FileDialogがベストチョイスか。