Sub 清理填充颜色()
Dim strFolder As String
'选择文件夹模块
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "选择目标所在文件夹"
.InitialFileName = "f:\"
If .Show = False Then Exit Sub
strFolder = .SelectedItems(1) & "\"
Getfd (strFolder)
End With
End Sub
Sub Getfd(ByVal pth)
Set Fso = CreateObject("scripting.filesystemobject")
Set ff = Fso.getfolder(pth)
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'For Each f In ff.Files
'a = a & f
'Next
' If a Like "*xls?" Then
On Error Resume Next
For Each f In ff.Files
Set wb = Workbooks.Open(f, 0)
For Each Sh In wb.Sheets
If Application.WorksheetFunction.CountA(Sh.Cells) 0 Then
Sh.UsedRange.Interior.ColorIndex = xlNone '清理填充颜色
End If
Next
wb.Close SaveChanges:=True
Next f
'穿透下级文件夹
For Each fd In ff.subfolders
Getfd (fd)
Next fd
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
