打开时运行Workbook_Open的VBA问题

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

问题虽然是打开时不会触发Workbook_Open事件。 作为一个临时解决scheme，我在运行macros启动程序的电子表格上放了一个button，但是我需要做的比这更好。 你可以看看这个网站的代码，并让我知道为什么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

这可以隐藏function区/命令栏（虽然File或Backstage菜单仍然存在，以为我认为你可能可以禁用这个我还没试过），如果你隐藏了其他的东西，比如StatusBar等等，这可能不足以解决你的问题，但在这里它是反正。

使用CustomUI编辑器 ，打开XLSM文件。

注意：当您通过自定义用户界面编辑器打开XLSM文件时，不应在任何Excel实例中打开XLSM文件。 如果它在Excel中打开，则对XML的修改将不会被正确保存。

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

从菜单中，插入Office 2010自定义用户界面部分：

然后复制并粘贴这个XML：

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

最后，通过CustomUI编辑器保存并closures文件，然后在Excel中重新打开。 您应该看到，此文件/工作簿处于活动状态时，function区不存在。

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

startFromScratch属性使得当这个工作簿具有焦点时，在应用程序的窗口中显示给用户的唯一的function区元素是在XML中定义的那些元素，正如你可能在上面的代码片段中收集的那样没有 。

这也完全避免了在Excel应用程序的新实例中尝试打开该文件的副本的需要（除非你有其他一些古怪的要求）似乎不必要地繁琐和有问题。