简体   繁体   中英

VBA issue with running Workbook_Open upon opening

When a user opens my VBA program it hides all Excel's command bar's and whatnot so it looks as if my program is not running in Excel at all. Since this action will take place across all instances of Excel I found some code that will check if other programs are open, and if so save my program as a temp file and reopen it in a new instance of Excel.

The problem though is when it opens it doesn't fire off the Workbook_Open event. As a temporary fix I've put a button on a spreadsheet that runs the macro to launch the program but I need to do better than this. Can you take a look at the code at this site and let me know why the Workbook_Open event is not firing? (as you can see I've already asked the forum twice for help on it with no response).

The code that duplicates the program and opens the new instance is in the UserForm section of code at the bottom.

Placed in 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

Placed in standard module:

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

Placed in class module:

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

Placed in 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

This works to hide the Ribbon/command bars (although the File or Backstage menu is still present, thought I think you may be able to disable this I have not tried yet), if you are hiding other stuff like the StatusBar, etc., it may not be enough to solve your problem, but here it is anyways.

Using the CustomUI editor , open the XLSM file.

Note: The XLSM file should not be open in any instance of Excel when you are opening it through the Custom UI Editor. If it is open in Excel, the modifications to the XML will not be saved properly.

Once you have the file open in the CustomUI Editor, you'll see this:

在此处输入图片说明

From the menu, Insert Office 2010 Custom UI Part:

在此处输入图片说明

Then copy and paste this XML:

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

Finally, save & close the file through the CustomUI Editor, then re-open in Excel. You should see that the while this file/workbook is active, the ribbon does not exist.

在此处输入图片说明

But, if you switch to another Workbook file, the ribbon will re-appear while that file is active.

在此处输入图片说明

The startFromScratch property makes it so that when this Workbook has focus, the only ribbon elements which are displayed to the user, within the Application's window, are those which are defined within the XML, which as you can probably gather in the snippet above, are none .

This also entirely avoids the need to try and open copies of the file in a new instance of Excel Application, which (unless you have some other quirky requirements) seems unnecessarily cumbersome and problematic.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM