打開時運行Workbook_Open的VBA問題

Question

當用戶打開我的VBA程序時，它會隱藏所有Excel的命令欄以及其他所有命令欄，因此看起來好像我的程序根本不在Excel中運行。 由於此操作將在Excel的所有實例中進行，因此我找到了一些代碼來檢查是否打開了其他程序，如果有，則將程序另存為臨時文件，然后在新的Excel實例中將其重新打開。

問題是，當它打開時不會觸發Workbook_Open事件。 作為臨時修復，我在運行宏的電子表格上放置了一個按鈕以啟動程序，但我需要做得更好。 您能否看一下此站點上的代碼，並讓我知道為什么Workbook_Open事件沒有觸發？ （如您所見，我已經兩次向論壇尋求幫助，但沒有任何回復）。

用代碼更新

復制程序並打開新實例的代碼在底部的UserForm部分中。

放在本工作簿中：

Private Sub Workbook_Open()

    Set clsAPP.XLAPP_ORIG = Application

    If Application.UserControl Then
        If Application.Workbooks.Count > 1 Then
            Application.Visible = False
            DoEvents
            frmCreateReplicant.Show vbModal
        End If
    End If

    Call ThisWorkbook_CompleteOpening
End Sub

放置在標准模塊中：

Option Explicit

Public XLAPP_Copy           As New Excel.Application, _
       clsAPP               As New clsXLApp

Public Sub ThisWorkbook_Open()
Dim intMaxRow                   As Integer

    If Application.Workbooks.Count > 1 Then
        Application.Visible = False
        DoEvents
        frmCreateReplicant.Show vbModal
        'Call ThisWorkbook_CompleteOpening
    Else
        ThisWorkbook_CompleteOpening
    End If

    ThisWorkbook.Saved = True
    Delay

End Sub

Sub ThisWorkbook_CompleteOpening(Optional Fake)

    'MsgBox "...Any other OnOpen code here..."
End Sub

Function Delay(Optional SecondFraction As Single = 0.2)
Dim sngTimeHack As Single, dtmDate As Date
    sngTimeHack = Timer:   dtmDate = Date

    If sngTimeHack + SecondFraction < 86400 Then
        Do
            DoEvents
        Loop While Timer < (sngTimeHack + SecondFraction)
    Else
        If dtmDate = Date Then
            Do
                DoEvents
            Loop While dtmDate = Date
        End If

        sngTimeHack = (sngTimeHack + SecondFraction) - 86400
        If DateAdd("d", 1, dtmDate) = Date Then
            Do
                DoEvents
            Loop While Timer < sngTimeHack
        End If
    End If
End Function

Function KillMeBasic()
    With ThisWorkbook
        .Saved = True
        .ChangeFileAccess Mode:=xlReadOnly
        Kill .FullName
        .Close False
    End With
End Function

放在類模塊中：

Option Explicit

Public WithEvents XLAPP_ORIG            As Application

Private Sub XLAPP_ORIG_NewWorkbook(ByVal Wb As Workbook)
    Wb.Close False
    MsgBox MsgTxt(1), 64, vbNullString
End Sub

Private Sub XLAPP_ORIG_WorkbookOpen(ByVal Wb As Workbook)
    If Not Wb.Name = ThisWorkbook.Name Then
        Wb.Close False
        MsgBox MsgTxt(2), 64, vbNullString
    End If
End Sub

Private Function MsgTxt(Opt As Long) As String
    Select Case Opt
    Case 1
        MsgTxt = _
        "Sorry, you cannot create a new workbook here." & vbCrLf & _
        "You can start a new instance of Excel by..."
    Case 2
        MsgTxt = _
        "You cannot open another workbook here.  You" & vbCrLf & _
        "can open another workbook by first..."
    End Select
End Function

放在用戶窗體中：

Private Sub UserForm_Activate()
Dim strThisWorkbookFullname     As String
Dim wbMeCopy                    As Workbook

    Delay 0.05

    Set XLAPP_Copy = CreateObject("Excel.Application")

    strThisWorkbookFullname = ThisWorkbook.FullName

    Application.DisplayAlerts = False
    ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\00000000001.xls", _
                        Password:="NeedKilled", AddToMru:=False
    Application.DisplayAlerts = True

    Do While ThisWorkbook.Saved = False
    Loop

    Delay 0.2

    XLAPP_Copy.Workbooks.Open Filename:=strThisWorkbookFullname, AddToMru:=False

    Do
        On Error Resume Next
        Set wbMeCopy = XLAPP_Copy.Workbooks(1)
        On Error GoTo 0
    Loop While wbMeCopy Is Nothing

    Set wbMeCopy = Nothing

    Delay 0.1

    Application.Visible = True
    XLAPP_Copy.Visible = True

    Unload Me
    Delay
    Call KillMeBasic
End Sub

Private Sub UserForm_Initialize()
    With Me
        .BackColor = &H0&
        .Caption = ""
        .ForeColor = &H0&
        .Height = 123
        .Width = 240
        With .lblMsg
            .BackColor = &H0&
            .Caption = String(2, vbCrLf) & _
                       "Please wait, I am protecting the program..."
            With .Font
                .Name = "Century Gothic"
                .Size = 10
            End With
            .ForeColor = &HC000C0
            .Height = 90
            .Left = 6
            .TextAlign = fmTextAlignCenter
            .Top = 6
            .Width = 222
        End With
    End With

End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = vbFormControlMenu _
        Then Cancel = True
End Sub

Answer 1

如果您要隱藏其他東西（例如StatusBar等），這可以隱藏功能區/命令欄（盡管“ File或“后台”菜單仍然存在，以為我認為您可能可以禁用我尚未嘗試過的菜單），它可能不足以解決您的問題，但無論如何，這里還是有。

使用CustomUI編輯器 ，打開XLSM文件。

注意：通過自定義UI編輯器打開XLSM文件時，不應在任何Excel實例中打開XLSM文件。 如果在Excel中打開，則對XML的修改將無法正確保存。

在CustomUI編輯器中打開文件后，您將看到以下內容：

從菜單中，插入Office 2010自定義UI部件：

然后復制並粘貼以下XML：

<customUI xmlns="http://schemas.microsoft.com/office/2009/07/customui">
    <ribbon startFromScratch="true" />
</customUI>

最后，通過CustomUI編輯器保存並關閉文件，然后在Excel中重新打開。 您應該看到該文件/工作簿處於活動狀態時，功能區不存在。

但是，如果切換到另一個工作簿文件，則該文件處於活動狀態時，功能區將重新出現。

startFromScratch屬性使它成為焦點，以便當此工作簿具有焦點時，在應用程序窗口中向用戶顯示的唯一功能區元素是在XML中定義的那些元素，您可以在上面的代碼段中收集這些元素。 沒有 。

這也完全避免了在新的Excel Application實例中嘗試打開文件副本的需要（除非您有其他一些古怪的要求），這似乎不必要地麻煩且成問題。