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

删除没有颜色的标签

1 个答案: