VBA 清除某个文件夹下的所有xls文件的公式

Sub Command()

On Error Resume Next

Application.DisplayAlerts = False

Dim wb As Workbook

Dim lj, dirname

Application.ScreenUpdating = False

With Application.FileDialog(msoFileDialogFolderPicker)

.InitialFileName = "C:\Users\" & Environ("username") & "\Desktop\"

If .Show = True Then Path = .SelectedItems(1) & "\"

End With

If Path = "" Then Exit Sub

lj = Path

i = 2

dirname = Dir(lj & "\*.xl*")

Do While dirname <> ""

Application.DisplayAlerts = False

Sheets("sheet1").Range("a" & i).Value = dirname & "已清除公式"

On Error Resume Next

Set wb = Workbooks.Open(lj & dirname)

With wb.Sheets("料单1")

.UsedRange.Value = .UsedRange.Value

End With

Application.DisplayAlerts = False

wb.Save

wb.Close False '关闭源文件,不保存

dirname = Dir

i = i + 1

Loop

Application.DisplayAlerts = True

Sheets("sheet1").Range("a1").Value = Path

Application.ScreenUpdating = True

MsgBox "ok"

End Sub