保存文件时绕过“检查兼容性”
我得到了一个循环遍历目录并执行计算的macros。 当我运行我的macros，我必须手动检查兼容性，有没有办法，我可以跳过整个检查兼容性？ 这种打败了这种自动化的目的。
Sub final() 'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them 'This Loops trough all files, does calc, then closes them. But right now I have to check compatibility for each file. 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) Dim xrng As Range, lrw As Long, lrng As Range, i As Long Dim LstCo As Long, ws As Worksheet With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With For Each ws In ActiveWorkbook.Worksheets With ws If Not Application.WorksheetFunction.CountA(.Cells) = 0 Then LstCo = .Cells.Find("*", , xlValues, xlWhole, xlByColumns, xlPrevious, False).Column For i = 1 To LstCo With .Columns(i) .TextToColumns Destination:=.Cells(1, 1), DataType:=xlDelimited, TrailingMinusNumbers:=True End With Next lrw = .Columns("A:Y").Find("*", , xlValues, , xlRows, xlPrevious).Row If lrw = 1 Then lrw = 2 Set lrng = .Range("A" & lrw + 2) With .Range("A2:A" & lrw) lrng.Formula = "=COUNTA(" & .Address(0, 0) & ")/ROWS(" & .Address(0, 0) & ")" End With Set xrng = .Range(lrng, .Cells(lrng.Row, LstCo)) lrng.AutoFill xrng, Type:=xlFillDefault xrng.Style = "Percent" End If End With Next With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic Application.CalculateFull End With 'Save and Close Workbook wb.Close SaveChanges:=True 'Get next file name myFile = Dir Loop 'Message Box when tasks are completed MsgBox "Task Complete!" ResetSettings: 'Reset Macro Optimization Settings Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub 在保存文件之前添加行wb.CheckCompatibility = False – 文档在这里