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

Question

我有下面的代码，关闭自动计算，我找不到为什么这样做的原因。我使用的是Office 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

我刚刚救了我的问题，我正面临与excel改为手动从自动cal与@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 

Answer 2

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

如果这些功能都打开其他书籍用于循环中，然后Variatus他的评论是正确的 - 这是在应用程序级的设置，因此所有的图书一样的应用实例中打开确实会受到影响，如果有，执行工作簿打开时包含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