指定したフォルダの配下(サブフォルダ配下含む)のエクセルファイルについて、下記処理を実行
※① フォント色を黒で統一する
※② 倍率を100%にする
※③ 選択セルを左上(A1)にする
④ 選択シートを表示シート(<>非表示シート)の中で一番左のシートにする
※:非表示シートは対象外
Sub ProcessExcelFilesInFolder()
Dim folderPath As String
Dim fileName As String
Dim wb As Workbook
Dim ws As Worksheet
' シートのセル C2 からフォルダパスを取得
folderPath = ThisWorkbook.Sheets(1).Range("C2").Value
' フォルダパスの最後に \ がない場合は追加
If Right(folderPath, 1) <> "\" Then
folderPath = folderPath & "\"
End If
MsgBox "処理を開始します"
' 指定フォルダとサブフォルダ内のすべてのファイルを処理
Call ProcessFiles(folderPath)
MsgBox "処理を完了しました!"
End Sub
Sub ProcessFiles(ByVal folderPath As String)
Dim fileName As String
Dim folder As Object
Dim subFolder As Object
Dim fso As Object
Dim wb As Workbook
Dim ws As Worksheet
' ファイルシステムオブジェクトを作成
Set fso = CreateObject("Scripting.FileSystemObject")
' フォルダ内のすべてのファイルをループ
fileName = Dir(folderPath & "*.xls*")
Do While fileName <> ""
' 各エクセルファイルを開く
Set wb = Workbooks.Open(folderPath & fileName)
' 各ワークシートに対して処理を行う
Dim n_一番左のシート As Integer: n_一番左のシート = 0
For Each ws In wb.Worksheets
If (ws.Visible) Then
If (n_一番左のシート = 0) Then
n_一番左のシート = ws.Index
End If
ws.Activate
' ①フォント色を黒にする
ws.Cells.Font.Color = RGB(0, 0, 0)
' ②倍率を100%に設定
'ws.Zoom = 100
ActiveWindow.Zoom = 100
' ③A1セルを選択
ws.Range("A1").Select
End If
Next ws
'④一番左のシートを選択
wb.Sheets(n_一番左のシート).Select
' 変更を保存して閉じる
wb.Close SaveChanges:=True
' 次のファイルへ
fileName = Dir
Loop
' サブフォルダをループして再帰的に処理
For Each subFolder In fso.GetFolder(folderPath).SubFolders
Call ProcessFiles(subFolder.Path & "\")
Next subFolder
End Sub