Question

我有以下代码关闭自动计算，我找不到这样做的原因。我使用的是2016年的办公室，之前使用的是2007年的注意事项，那时我会注意到手册，但我不知道现在我找到哪个宏来触发变更，但仍然不知道原因。任何有关澄清这一点的帮助将不胜感激。

Public Sub editAllSheets()
'
'
'
    Dim myResult As VbMsgBoxResult
Dim WS As Worksheet

    myResult = MsgBox("Are you sure you want to edit all sheets in this workbook?", vbQuestion + vbYesNo + vbDefaultButton1, "Edit Workbook?")
    If myResult = vbNo Then Exit Sub

       On Error GoTo ErrorHandler

            For Each WS In ActiveWorkbook.Worksheets
            WS.Activate
            Application.ScreenUpdating = False
             editingProperties WS
             Application.ScreenUpdating = True
                Next WS
            Sheets.Select

            MsgBox "Please note:" & vbNewLine & vbNewLine & "1. All the sheets are selected." & vbNewLine & "2. Proceed with print preview to view and print all reports." & vbNewLine & "3. To print preview or print only 1 report of this workbook you need to click on a different sheet to deselect all.", vbInformation, "Process Completed!"

        Exit Sub '<--- exit here if no error occured
ErrorHandler:
    Debug.Print Err.Description
    Application.ScreenUpdating = True
        MsgBox "Sorry, an error occured." & vbCrLf & Err.Description, vbCritical, "Error!"

    End Sub

    Private Sub editingProperties(WS As Worksheet)

Dim columnsToDelete As Range

With WS
       .Columns("A:F").UnMerge

    Set columnsToDelete = Application.Union(.Columns("B:C"), _
                                            .Columns("F:K"), _
                                            .Columns("P:R"), _
                                            .Columns("V:W"))
        columnsToDelete.Delete

       .Cells.EntireColumn.AutoFit
       .Range("A1:B2").Merge

   End With


     With WS.PageSetup
            .PrintArea = ""
            .PrintTitleRows = ""
            .PrintTitleColumns = ""
            .LeftHeader = ""
            .CenterHeader = ""
            .RightHeader = ""
            .LeftFooter = ""
            .CenterFooter = ""
            .RightFooter = ""
            .LeftMargin = Application.InchesToPoints(0.25)
            .RightMargin = Application.InchesToPoints(0.25)
            .TopMargin = Application.InchesToPoints(0.75)
            .BottomMargin = Application.InchesToPoints(0.75)
            .HeaderMargin = Application.InchesToPoints(0.3)
            .FooterMargin = Application.InchesToPoints(0.3)
            .Orientation = xlLandscape
            .Zoom = False
           .FitToPagesWide = 1
            .FitToPagesTall = 1

        End With
    End Sub

过去，我使用下面的代码使宏更快，但我注意到从自动计算到手动更改而没有运行任何东西所以我删除不确定它是否仍然相关。任何有关解决此问题的帮助都将非常感激。

Option Explicit
Sub OptimizeVBA(isOn As Boolean)
    Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
    Application.EnableEvents = Not(isOn)
    Application.ScreenUpdating = Not(isOn)
    ActiveSheet.DisplayPageBreaks = Not(isOn)
End Sub

'Some macro
Sub ExampleMacro()
    OptimizeVBA True
    'Your code here
    OptimizeVBA False
End Sub

Answer 1

此宏运行完美，无需关闭计算。

如果在打开其他书籍的循环中使用这些函数，那么Variatus的评论是正确的 - 这是应用程序级别的设置，因此如果有一个执行代码的工作簿，那么在同一个Application实例中打开的所有书籍都会受到影响打开时包含Application.Calculation = xlCalculationManual

解决方法是将单独的对象实例化为“新应用程序”，并使用该对象打开其他工作簿。示例代码：

而不是：

Dim wb as Workbook
Set wb = Workbooks.Open("Somepath\somefile.xlsm")

使用：

Dim xlApp as Application
Dim wb as Workbook

Set xlApp = New Application

Set wb = xlApp.Workbooks.Open("Somepath\somefile.xlsm")
'Do stuff 

wb.Close
xlApp.Close
Set xlApp = Nothing

另一种方法是将当前设置存储在变量中，并在执行结束时重置它：

'At the very beginning:
Dim calcSetting as Integer
calcSetting = Application.Calculation

'Do all execution

'At the every end:
Application.Calculation = calcSetting

Answer 2

我刚刚解决了我的问题，我正在面对excel从@Variatus帮助自动计算转换为手动。问题是如果你去右键并选择所有工作表excel会自动更改为手动但是只要你右键单击并ungroup sheets这将改回automatic calculation。因此，我更改了我的代码以选择第一张工作表来取消选择代码末尾的所有工作表，并且只有一个工作表处于活动状态，因此计算将恢复为自动。也可以从选择所有工作表改为Worksheets.PrintOut preview:=True，这将具有相同的效果，但是代码的意图非常明确。因此，在选择多个工作表时需要小心，以便以后取消选择它们，否则会产生问题，从而将计算从自动变为手动。谢谢你的帮助。

Option Explicit
 Public WS As Worksheet

    Public Sub editAllSheets()
'
'
    Dim myResult As VbMsgBoxResult

    myResult = MsgBox("Are you sure you want to edit all sheets in this workbook?", vbQuestion + vbYesNo + vbDefaultButton1, "Edit Workbook?")
    If myResult = vbNo Then Exit Sub

       On Error GoTo ErrorHandler

            For Each WS In ActiveWorkbook.Worksheets
            WS.Activate
            Application.ScreenUpdating = False
             editingProperties WS
            Application.ScreenUpdating = True
                Next WS

            MsgBox "Please note:" & vbNewLine & vbNewLine & "1. You will be redirected to print preview all your reports." & vbNewLine & "2. Proceed with printing reports.", vbInformation, "Process Completed!"

         Worksheets.PrintOut preview:=True

         Sheets(1).Select

        Exit Sub '<--- exit here if no error occured
ErrorHandler:
    Debug.Print Err.Description
        MsgBox "Sorry, an error occured." & vbCrLf & Err.Description, vbCritical, "Error!"

    End Sub

    Private Sub editingProperties(WS As Worksheet)

Dim columnsToDelete As Range

With WS
       .Columns("A:F").UnMerge

    Set columnsToDelete = Application.Union(.Columns("B:C"), _
                                            .Columns("E:J"), _
                                            .Columns("N:P"), _
                                            .Columns("T"))
        columnsToDelete.Delete

       .Cells.EntireColumn.AutoFit
       .Range("A1:B2").Merge

   End With


     With WS.PageSetup
            .printArea = ""
            .PrintTitleRows = ""
            .PrintTitleColumns = ""
            .LeftHeader = ""
            .CenterHeader = ""
            .RightHeader = ""
            .LeftFooter = ""
            .CenterFooter = ""
            .RightFooter = ""
            .LeftMargin = Application.InchesToPoints(0.25)
            .RightMargin = Application.InchesToPoints(0.25)
            .TopMargin = Application.InchesToPoints(0.75)
            .BottomMargin = Application.InchesToPoints(0.75)
            .HeaderMargin = Application.InchesToPoints(0.3)
            .FooterMargin = Application.InchesToPoints(0.3)
            .Orientation = xlLandscape
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = 1

        End With
    End Sub

为什么VBA宏关闭了自动计算？

2 个答案: