Excelファイルをお客様へ納品する際、全てのシートがA1セルを選択した状態でお渡しするのがお決まりになっていますよね。
さらに言うなら最初のシートを選択した状態、かつ1番左上にスクロールしておくことも欠かせません。
個人的にはそこまでしなくても…と思いますが、相手に対する気遣いです。
確かに受け取る側の立場だと、ありがたいことだと感じます。
しかし、ドキュメントを作成する側は、修正する度に毎回これを行わないければならないので、とても面倒だと思います。
複数のExcelファイルを一括でA1選択！
世の中には同じ事を考えている方はたくさんいるようです。
ブックを閉じる際にA1セルを選択してくれるアドオンはあるのですが、一括でExcelファイルを処理してくれるものは中々見つかりませんでした…。
そこで、サブディレクトリを含む全てのExcelファイルの全てのシートのA1セルを選択して保存する便利なExcelマクロ（VBA）を作成しました！
サブディレクトリを含めたファイル一覧を取得
まずは、サブディレクトリを含めた複数のExcelファイル一覧を取得します。
下記の参考サイトほぼ丸パクリさせて頂きましたw
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 |
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%
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 |
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.SelectEnd Sub |
使い方・注意点
以下のコードをどこかにコピペして実行してください。
A1セルに対象ディレクトリのパスを書くようにしました。
「開発」→「挿入」→「フォームコントロール」でボタンを配置しで実行しています。
拡張子は「xlsx」を指定。（古い拡張子のxlsは考慮してません）
実行する際は、他のブックをすべて閉じてください。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 |
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 & "ファイルを処理しました！", vbInformationEnd Sub |
ダウンロード
一応、すぐに使えるようにマクロ（VBA）入りのファイルを作成したので、良かったらダウンロードしてみてください。 SelectA1_v1.0.zip簡単に作ったので気に入らない所は変更してください。
私は特定のシートに指定した日付を入れたりしましたよ！
これで仕事が楽になりました！
コメント