こんにちは!するどいプランナーです!
今日も簡単なVBAの使用例です。前回作成した「エクセル資料のカーソル位置をデフォルト位置にする」を改良していきます。
仕様書として提出するエクセルファイルのお作法として
- ファイルを開いたとき、トップページ(=一番左のタブ)を表示する
- 各シートを開いたとき、カーソルを一番左上にする
ことが求められたりしますが、前回はそれを自動化するVBAマクロについて説明しました。その時に改善点として記載した
- フォルダのパスを自由に指定できる
- 子フォルダの中も再帰的に処理する
に対応していきます。
◆完成イメージ
処理の概要
特定フォルダ内の全.xlsx/.xlsmファイルに対して
- 表示されるシートを一番左のタブのものにする
- カーソル位置をA1にする
- 保存する
の処理を行います。
また、サブフォルダ内を再帰的に検索し、同様の処理を行います。
今回は3つの関数を使用します。
①提出用の調整
提出用の表示調整を、1つのファイルに対して行います。
引数はファイルオブジェクトです。
②提出用の調整_マクロボタン
画面更新を止める、対象となるパスを読み込む、等の準備処理を行います。
マクロボタンにはこの関数を登録します。
③提出用の調整_再帰的に処理
フォルダ内を再帰的に検索し、対象となるファイルを処理する関数を呼び出します。
引数はパスとファイルシステムオブジェクトです。
◆VBAマクロ①提出用の調整()
前回からファイル開閉のタイミングを変更し、この関数内に持ってきました。
1個のファイルに対する処理をこの中にまとめた感じですね。
引数「file」はファイルオブジェクトです。ByValをつけることで値渡しにしています。
処理の内容にわかりにくいところはないかと思います。
' カーソルをA1に移動して一番左のシートを選択する
Sub 提出用の調整(ByVal file As Object)
'ファイルを開いてブックとして取得
Dim wb As Workbook
Set wb = Workbooks.Open(file)
' ブックの全シートを 1 つずつループして処理する
Dim objSheet As Worksheet
For Each objSheet In wb.Worksheets
'A1を選択、スクロール位置も移動
objSheet.Activate
Application.Goto Reference:=Range("A1"), Scroll:=TrueNext
'一番左のシートを選択する
Dim i As Long
For i = 1 To wb.Worksheets.Count
'指定シートが表示(xlSheetVisible)されていれば、選択する。
If Worksheets(i).Visible = xlSheetVisible Then
Worksheets(i).Select
GoTo SAVE_END
End If
Next iSAVE_END:
'保存して閉じる
wb.Save
Call wb.Close(SaveChanges:=True)
End Sub
◆VBAマクロ②提出用の調整_マクロボタン
こちらも処理の内容にわかりにくいところは無いかと思います。
処理対象にするパスをセル「B11」から読み取っています。
ファイルシステムオブジェクトを作成し、再帰関数に渡しています。
'マクロに登録する関数
Sub 提出用の調整_マクロボタン()
'画面の更新を止める
Application.ScreenUpdating = False
'ファイルシステムオブジェクトを作っておく
Dim path As String
Dim fs As Object
path = Range("B11").Value
Set fs = CreateObject("Scripting.FileSystemObject")'フォルダ内の全ファイルについて処理
Call 提出用の調整_再帰的に処理(path, fs)
'画面の更新を元に戻す
Application.ScreenUpdating = True
End Sub
◆VBAマクロ③提出用の調整_再帰的に処理
この関数が今回のポイントですね。
サブフォルダ内のサブフォルダ内のサブフォルダ内の・・・を処理するため、再帰関数を使用しています。(※1)のところで自分自身を呼び出すことで、子フォルダに対して同じ処理を再帰的に繰り返します。
(※2)では、拡張子を調べることで見つけたファイルがExcelファイルの場合のみ(※3)の処理を行うようにしています。
'フォルダ内の全ファイルについて処理
Sub 提出用の調整_再帰的に処理(ByVal topPath As String, ByVal fs As Object)Dim folder As Object
Dim file As Object
'サブフォルダの数だけ再帰(※1)
For Each folder In fs.getFolder(topPath).SubFolders
Call 提出用の調整_再帰的に処理(folder.path, fs)
Next'現フォルダ内の全ファイルを処理
For Each file In fs.getFolder(topPath).files
'Excelファイルの場合のみ処理を行う(※2)
If LCase(fs.GetExtensionName(file.Name)) = "xlsx" Or _
LCase(fs.GetExtensionName(file.Name)) = "xlsm" Then
'Excelファイルに対する処理(※3)
Call 提出用の調整(file)
End If
NextEnd Sub
◆まとめ
今回は前回作成したVBAを改良し、
- フォルダのパスを自由に指定できる
という機能を追加しました。
何を自動化するかという機能自体も大事なのですが、そもそもツールは使われてナンボのものですから、使い勝手や手順のわかりやすさなど使用者側からの視点を忘れないようにしましょう。
◆補足
今回は再帰関数を使用することで、サブフォルダ内のファイルすべてのファイルに対して処理を行うように改造を行いました。場合によってはサブフォルダ以下は処理したくない!ということもあるでしょうから、オプション化してもよいかもしれません。