Question

当用户打开我的VBA程序时，它会隐藏所有Excel的命令栏等等，所以看起来好像我的程序根本没有在Excel中运行。由于此操作将在Excel的所有实例中发生，因此我找到了一些代码，用于检查其他程序是否已打开，如果是，则将我的程序保存为临时文件并在新的Excel实例中重新打开。

问题是，当它打开时，它不会触发Workbook_Open事件。作为临时修复，我在运行宏的电子表格上放了一个按钮来启动程序，但我需要做得比这更好。你能看看这个网站上的代码，让我知道为什么Workbook_Open事件没有被解雇？（正如你所看到的，我已经两次向论坛请求帮助而没有回复）。

更新了代码

复制程序并打开新实例的代码位于底部代码的UserForm部分。

放在ThisWorkbook中：

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

放在UserForm中：

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

这可以隐藏功能区/命令栏（虽然File或Backstage菜单仍然存在，我认为你可能能够禁用它我尚未尝试过），如果你隐藏其他东西，如StatusBar等，它可能不足以解决你的问题，但无论如何它都是。

使用CustomUI editor，打开XLSM文件。

注意：当您通过自定义UI编辑器打开XLSM文件时，不应在任何Excel实例中打开该文件。如果它在Excel中打开，则无法正确保存对XML的修改。

在CustomUI编辑器中打开文件后，您会看到：

从菜单中，插入Office 2010自定义UI部件：

然后复制并粘贴此XML：

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

最后，保存＆amp;通过CustomUI编辑器关闭文件，然后在Excel中重新打开。您应该看到，当此文件/工作簿处于活动状态时，功能区不存在。

但是，如果您切换到另一个工作簿文件，该功能区将在该文件处于活动状态时重新显示。

startFromScratch属性使得当此工作簿具有焦点时，在应用程序窗口中向用户显示的唯一功能区元素是在XML中定义的那些，这可能是您可能的收集在上面的代码段中， none 。

此还完全避免了在Excel应用程序的新实例中尝试打开文件副本的需要，除非您有其他一些古怪的要求，否则这些文件似乎不必要地繁琐且有问题。

打开

1 个答案: