【VBA】色のついたシート名を取得

フォルダに格納されているファイル全てに対して、シート名の色づきを確認しにいき、もし色がついている場合は別ファイルにシート名を記載するといったマクロを組みたいです。方法をご教示いただくことは可能でしょうか。

No.2 回答者： fujillin 回答日時： 2022/06/22 16:44

こんにちは

いくつかの処理があると思いますが、どのあたりがわからないのでしょうか？
全体的に記しておくなら。

1）フォルダに格納されているファイル全てに対して～
フォルダが指定されているのなら、Dir関数等を利用して、「*.xlsx」ファイル等を順に検索して処理するループを行えば宜しいでしょう。
（FileSystemObjectを利用する方法でも可能です）

2）シート名の色づきを確認しにいき、～
個々のブックを開かないと確認はできません。
　Workbooks.Open
　Workbooks.Add
などで開くことができます。
その上で、（どのシートなのかわかりませんが）「シートの色づき」というのが、「シートのタブの色」のことであるのなら、
　Worksheet.Tab.Color
で色を取得できますので、それで判断なされば良いでしょう。
（タブの色ではない場合は、そちらを調べるようにしてください）

もしも、全シートを調査したいのなら、
　For Each sht In Worksheets
のような感じでループすれば良いです。

3）もし色がついている場合は別ファイルにシート名を記載する
別ファイル（＝開いておく必要があります）の記載を始めるセル位置を変数に入れておいて、
シート名を記載するなら、
　変数.Value = Worksheet.Name
　Set 変数 = 変数.Offset(1)
などとするようにしておけば、変数は常に次に記載するセルを示すことになるので、順次記入してゆくことが可能になります。

No.1 回答者： Qchan1962 回答日時： 2022/06/22 16:37

方法

フォルダを選ぶ
Dirでファイルを確認
Workbooks.Open　で開く
For Each sht In Worksheetsですべてのシートをループ
.Tab.ColorIndex <> xlNone　で色のついてるタグで分岐処理

Sub EXample()
Dim folderPath As String, Bk As String
Dim ThisSht As Worksheet
Dim sht As Worksheet
Dim n As Long
Set ThisSht = ActiveSheet

With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "フォルダの選択"
.InitialFileName = CreateObject("WScript.Shell").SpecialFolders("Desktop")
If .Show = True Then
folderPath = .SelectedItems(1) & "\"
Else
Exit Sub
End If
End With
Application.ScreenUpdating = False
Bk = Dir(folderPath & "*.xls*")
Do Until Bk = ""
Workbooks.Open folderPath & Bk
For Each sht In Worksheets
If sht.Tab.ColorIndex <> xlNone Then
n = n + 1
ThisSht.Cells(n, 1) = Bk
ThisSht.Cells(n, 2) = sht.Name
End If
Next
Workbooks(Bk).Close SaveChanges:=False
Bk = Dir
Loop
Application.ScreenUpdating = True
End Sub

全ファイル・・Excelで
全ファイル・・・どのブックか分らなくなりそうなので

コードを見ればわかると思いますが、実行ブックのアクティブシートに
ブック名　A列　シート名　B列

エラー処理はしていません