Question

我有一个循环遍历目录并执行计算的宏。当我运行我的宏时，我必须手动检查兼容性，有没有办法可以跳过整个检查兼容性？它有点挫败了这种自动化的目的。

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

Answer 1

在保存文件之前添加行wb.CheckCompatibility = False - 文档here

保存文件时绕过“检查兼容性”

1 个答案: