【VBA】サブフォルダを含む全てのExcelシートをA1選択で保存する

Excelファイルをお客様へ納品する際、全てのシートがA1セルを選択した状態でお渡しするのがお決まりになっていますよね。
さらに言うなら最初のシートを選択した状態、かつ1番左上にスクロールしておくことも欠かせません。
個人的にはそこまでしなくても…と思いますが、相手に対する気遣いです。
確かに受け取る側の立場だと、ありがたいことだと感じます。
しかし、ドキュメントを作成する側は、修正する度に毎回これを行わないければならないので、とても面倒だと思います。

複数のExcelファイルを一括でA1選択！

世の中には同じ事を考えている方はたくさんいるようです。
ブックを閉じる際にA1セルを選択してくれるアドオンはあるのですが、一括でExcelファイルを処理してくれるものは中々見つかりませんでした…。
そこで、サブディレクトリを含む全てのExcelファイルの全てのシートのA1セルを選択して保存する便利なExcelマクロ（VBA）を作成しました！

サブディレクトリを含めたファイル一覧を取得

まずは、サブディレクトリを含めた複数のExcelファイル一覧を取得します。
下記の参考サイトほぼ丸パクリさせて頂きましたw

Public Function GetFilePathList(ByVal specifiedFolder As String, _
        ByVal filePattern As String, _
        ByVal containsSubFolder As Boolean, _
        ByRef filePathList As Object)

    Dim GetFileName As String
    Dim subFolder As Object

    GetFileName = Dir(specifiedFolder & "\" & filePattern)
    Do While GetFileName <> ""
        Call filePathList.Add(specifiedFolder & "\" & GetFileName)
        GetFileName = Dir()
    Loop

    If containsSubFolder Then
        With CreateObject("Scripting.FileSystemObject")
            For Each subFolder In .GetFolder(specifiedFolder).SubFolders
                Call GetFilePathList(subFolder.Path, _
                        filePattern, _
                        containsSubFolder, _
                        filePathList)
            Next subFolder
        End With
    End If
End Function

スクロール等にも対応したA1セル選択！

こちらも他のサイトを参考にさせて頂きましたw
ただのスクロール対策だけでなく、以下の内容にも対応しました！

• 非表示シート対応
• ウィンドウ枠の固定でもスクロール
• オートフィルタの絞り込み解除
• 拡大表示100%

Sub SelectSheet()

    Dim sht As Worksheet
    Dim shtVisible
    Dim hiddenFlg As Boolean
    Dim iRow, iCol

    For Each sht In ActiveWorkbook.Worksheets
        hiddenFlg = False
        If sht.Visible = xlSheetHidden Then
            hiddenFlg = True
            sht.Visible = xlSheetVisible
        Else
            Set shtVisible = sht
        End If
        
        sht.Select
        
        If ActiveWindow.FreezePanes = True Then
            iRow = ActiveWindow.SplitRow + 1
            iCol = ActiveWindow.SplitColumn + 1
            Cells(iRow + 1, iCol + 1).Activate
        End If
        
        If Not sht.AutoFilter Is Nothing Then
            If sht.AutoFilter.FilterMode = True Then
                sht.AutoFilter.ShowAllData
            End If
        End If

        Range("A1").Select
        ActiveWindow.Zoom = 100
        ActiveWindow.ScrollColumn = 1
        ActiveWindow.ScrollRow = 1
        
        If hiddenFlg Then
            sht.Visible = xlSheetHidden
        End If
    Next

    shtVisible.Select

End Sub

使い方・注意点

以下のコードをどこかにコピペして実行してください。
A1セルに対象ディレクトリのパスを書くようにしました。
「開発」→「挿入」→「フォームコントロール」でボタンを配置しで実行しています。
拡張子は「xlsx」を指定。（古い拡張子のxlsは考慮してません）
実行する際は、他のブックをすべて閉じてください。

Sub main()

    Dim filePathList As Object
    Dim filePath As Variant
    Dim result As String
    Dim cnt As Long
    Dim obj
    
    If Workbooks.Count > 1 Then
        MsgBox "他のEXCELファイルが開いてます！" & vbCrLf & "閉じてからもう一度やり直してください。", vbCritical
        Exit Sub
    End If
    
    Set filePathList = VBA.CreateObject("System.Collections.ArrayList")
    Call GetFilePathList(Range("A1").Value, "*.xlsx", True, filePathList)

    cnt = 0
    For Each filePath In filePathList
        cnt = cnt + 1
        Application.ScreenUpdating = True
        Application.StatusBar = filePath & "を処理中..."
        Application.ScreenUpdating = False
        
        Workbooks.Open filePath
        Call SelectSheet
        ActiveWorkbook.Save
        ActiveWorkbook.Close
    Next filePath
    
    Application.ScreenUpdating = True
    Application.StatusBar = False
    MsgBox cnt & "ファイルを処理しました！", vbInformation

End Sub

ダウンロード

一応、すぐに使えるようにマクロ（VBA）入りのファイルを作成したので、良かったらダウンロードしてみてください。

SelectA1_v1.0.zip

簡単に作ったので気に入らない所は変更してください。
私は特定のシートに指定した日付を入れたりしましたよ！
これで仕事が楽になりました！

• Original:https://minory.org/vba-select-a1.html
• Source:Minory
• Author:管理者