基于无颜色删除选项卡

Question

我有一个工作簿，其中一些选项卡是蓝色的，其余的没有颜色。 我想知道是否有办法创建一个宏来删除没有颜色的标签。

我需要这个的原因是因为我有一个代码允许遍历文件夹并引入新标签以每个月替换旧标签。当他们进来时，他们没有颜色。

我想在运行我目前拥有的代码之前运行一个宏来删除无色选项卡。

如果没有办法删除无色选项卡，我想要一个代码来自动将被带入的选项卡变为绿色，以便可以删除绿色选项卡下个月。-使用代码删除带有绿色的标签

以下是我目前拥有的代码。

Sub LoopAllExcelFilesInFolder()

Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog

'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
 Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With

'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings

'Target File Extension (must include wildcard "*")
 myExtension = "*.xls*"

'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set wb = Workbooks.Open(Filename:=myPath & myFile)

'Ensure Workbook has opened before moving on to next line of code
DoEvents
WorksheetLoop wb
'Change First Worksheet's Background Fill Blue
'wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)


'Save and Close Workbook
wb.Close SaveChanges:=True

'Ensure Workbook has closed before moving on to next line of code
 DoEvents

'Get next file name
 myFile = Dir
 Loop


ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Answer 1

删除没有颜色的标签的基本代码；您必须禁用警报。

Application.DisplayAlerts = False
Dim Sht As Worksheet

    For Each Sht In Worksheets
        If Sht.Tab.ColorIndex = xlColorIndexNone Then Sht.Delete
    Next

Application.DisplayAlerts = True