从关闭窗口激活Wosrksheet的功能符合预期，但没有从外接菜单的退出选项中激活

Question

我有一个代码工作簿和几个带有多个工作表的数据工作簿。关闭数据工作簿时，我需要能够激活特定的工作表。如果我使用数据工作簿右上角的“ X”，则工作表会更改。如果我在外接菜单栏中使用“退出”选项，即使该程序通过相同的BeforeClose代码运行，也不会激活正确的工作表。

以下代码在CodeBook.xlsm文件的代码模块中：

Option Explicit

Sub Auto_Open()
    'Establish a special menu
    MenuBars(xlWorksheet).Menus.Add Caption:="O&ptions"
    'Create Menu Items
    MenuBars(xlWorksheet).Menus("Options").MenuItems.Add Caption:="Open CodeBook1.xlsm", OnAction:="Open_File"
    MenuBars(xlWorksheet).Menus("Options").MenuItems.Add Caption:="Exit", OnAction:="AutoClose"

End Sub

Sub Open_File()
    Dim sPath As String
    sPath = ThisWorkbook.Path
    Workbooks.Open sPath & "\DataBook1.xlsm"
End Sub

Public Sub AutoClose()
    'See if an Event workbook or the Main workbood called the subroutine
    If ActiveWorkbook.Name <> ThisWorkbook.Name Then
        ActiveWorkbook.Save
        MsgBox "Before ActiveWorkbook.Close"
        ActiveWorkbook.Close
        MsgBox "Back from ActiveWorkbook.Close"
        Exit Sub
    End If
End Sub

以下代码在具有Sheet1和Sheet2的DataBook1.xlsm中的ThisWorkbook中：

Public Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim sBk As String
    Dim cApp As Object
    Set cApp = Application
    sBk = ThisWorkbook.Name
    ThisWorkbook.Save
    Worksheets("Sheet2").Activate
    MsgBox "Codebook Workbook Before Close  After Activate Sheet2" & vbNewLine & _
        "ActiveWindow " & ActiveWindow.Caption & vbNewLine & _
        "ThisWorkbook " & ThisWorkbook.Name & vbNewLine & _
        "ActiveWorkbook " & ActiveWorkbook.Name & vbNewLine & _
        "ActiveSheet " & ActiveSheet.Name & vbNewLine & _
        "Display Alerts " & Application.DisplayAlerts & vbNewLine & _
        "Events Enabled " & Application.EnableEvents & vbNewLine & _
        "Screen Updating " & Application.ScreenUpdating
    Worksheets("Sheet1").Activate
    MsgBox "Codebook Workbook Before Close After Activate Sheet1" & vbNewLine & _
        "ActiveWindow " & ActiveWindow.Caption & vbNewLine & _
        "ThisWorkbook " & ThisWorkbook.Name & vbNewLine & _
        "ActiveWorkbook " & ActiveWorkbook.Name & vbNewLine & _
        "ActiveSheet " & ActiveSheet.Name & vbNewLine & _
        "Display Alerts " & Application.DisplayAlerts & vbNewLine & _
        "Events Enabled " & Application.EnableEvents & vbNewLine & _
        "Screen Updating " & Application.ScreenUpdating
'    Cancel = True
End Sub

Private Sub Workbook_Open()
   Worksheets("Sheet1").Activate
End Sub

为了使测试更容易，请在DataBook ThisWorkbook代码中取消注释Cancel = True。

感谢任何能提供帮助的人。

Answer 1

我的测试表明无法从ThisWorkbook（即Workbook_BeforeClose等）内“激活”工作表。代码可以运行，但是什么也没有发生。

您可能可以通过首先在常规代码模块（位于数据工作表中）中执行激活来克服此问题。

例如，在DataBook1.xlsm中的模块中添加：

Option Explicit

Public Sub SwapSheets()
    Worksheets("Sheet2").Activate
    MsgBox "Codebook Workbook Before Close  After Activate Sheet2" & vbNewLine & _
        "ActiveWindow " & ActiveWindow.Caption & vbNewLine & _
        "ThisWorkbook " & ThisWorkbook.Name & vbNewLine & _
        "ActiveWorkbook " & ActiveWorkbook.Name & vbNewLine & _
        "ActiveSheet " & ActiveSheet.Name & vbNewLine & _
        "Display Alerts " & Application.DisplayAlerts & vbNewLine & _
        "Events Enabled " & Application.EnableEvents & vbNewLine & _
        "Screen Updating " & Application.ScreenUpdating
    Worksheets("Sheet1").Activate
    MsgBox "Codebook Workbook Before Close After Activate Sheet1" & vbNewLine & _
        "ActiveWindow " & ActiveWindow.Caption & vbNewLine & _
        "ThisWorkbook " & ThisWorkbook.Name & vbNewLine & _
        "ActiveWorkbook " & ActiveWorkbook.Name & vbNewLine & _
        "ActiveSheet " & ActiveSheet.Name & vbNewLine & _
        "Display Alerts " & Application.DisplayAlerts & vbNewLine & _
        "Events Enabled " & Application.EnableEvents & vbNewLine & _
        "Screen Updating " & Application.ScreenUpdating
End Sub

然后在执行其他代码之前，先在CodeBook.xlsm中修改您的AutoClose，以首先调用上述代码...。这一个

Public Sub AutoClose()
    'See if an Event workbook or the Main workbood called the subroutine
    If ActiveWorkbook.Name <> ThisWorkbook.Name Then

        ' do the activates here first
        ActiveWorkbook.Application.Run ("'" & ActiveWorkbook.Name & "'!SwapSheets")

        ActiveWorkbook.Save
        ActiveWorkbook.Close
        Exit Sub
    End If
End Sub