0
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

【個人用メモ】エクセルファイル黒フォント化マクロ

Posted at

image.png

指定したフォルダの配下(サブフォルダ配下含む)のエクセルファイルについて、下記処理を実行
※① フォント色を黒で統一する
※② 倍率を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

0
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
1

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?