如何创建将在不打开工作簿的情况下从加载项打开用户窗体的宏

时间:2014-12-16 16:49:14

标签: excel vba excel-vba userform

我开发了一个用户表单,用于查询表单的工作簿以获取信息。我希望此userform可以在其他工作簿中使用,以便用户可以在自己的工作簿中查找表单工作簿中的信息。

最初我在打开工作簿时尝试使用它:

Application.visible = False
Userform.show vbmodeless

但是,这将隐藏excel中的所有其他工作簿,这会使用户感到困惑。

然后我尝试将userform工作簿保存为excel加载项,并在功能区中创建一个宏,该宏将通过show vbmodeless函数启动表单,但这也会提取userform的工作簿。

我是VBA的新手;无论如何,如果用户可以在他们的工作簿中工作并在不打开userform的工作簿的情况下拉出我的用户表单,那就可以了。 userform不会与个人的个人工作簿进行交互,也不需要进行交互,只需要与表单所源自的工作簿进行交互。我希望这可以从功能区工作,但如果只是打开userform工作簿也可以。

谢谢!

1 个答案:

答案 0 :(得分:0)

我认为您的问题可能与您将其添加到功能区的方式有关。我有一个我为我的“有用的宏”团队创建的插件,它有几个调用userforms,我对显示的插件工作簿没有任何问题。不确定是否有其他方法,但这是我如何做到的。
在“本工作簿”工作簿_打开部分,我有以下几行代码

Call enableAddin
call CreateMMMacroMenu

enableAddin是一个自动安装例程,你可以使用或不使用,这是代码:

'---------------------------------------------------------------------------------------
' Procedure : enableAddIn
' Purpose   : Auto installed for the add-in
' Version   : 19/11/2014 : Mark Moore - Initial Version
'---------------------------------------------------------------------------------------
Sub enableAddIn()
Dim A As AddIn
Dim Listed As Boolean
On Error Resume Next
    Listed = False
    For Each A In Application.AddIns
        If A.Name = ThisWorkbook.Name Then
'            A.Installed = True
            Listed = True
            Exit Sub
        End If
    Next
    If Listed = False Then
        If MsgBox("This will install the 'Usefull Macros' Addin, do you wish to continue?" & _
         vbCrLf & vbCrLf & "NB: This file should be in the permanent location you will leave it in, " & _
         "as the addin will be accessed from its current location.  If you wish to put this file " & _
         "elsewhere, before installing it, select 'No' anf move the file to its permant location " & _
         "before opening it again", vbYesNo, "Install 'Usefull Macros' Addin?") = vbYes Then
            Application.Workbooks.Add
            AddIns.Add(ThisWorkbook.FullName, True) _
            .Installed = True
        Else
            MsgBox "Install Cancelled"
        End If
    End If
On Error GoTo 0
End Sub

CreateMMMacroMenu实际上是在功能区上创建菜单的,这是我的版本,但希望你能看到它是如何工作的,特别是按钮6是一个弹出宏,不作为是{{1}这只是一行"FindandCopy"

frmFindAndCopy.show

最后还在“本工作簿”Workbook_BeforeClose事件中,我有以下内容删除excel关闭时的菜单栏

'---------------------------------------------------------------------------------------
' Procedure : CreateMMMacroMenu
' Purpose   : Creates the Useful Macros Commnad bar and associated buttons
' Version   : 18/11/2014 : Mark Moore - Initial Version
'---------------------------------------------------------------------------------------
Sub CreateMMMacroMenu()
Dim myCB As CommandBar
Dim myCPup1 As CommandBarPopup

    ' Delete the CommandBar if it exists already, will error if it doesnt exist, so switch erro handling off
    On Error Resume Next
    Application.CommandBars("MMMacroMenu").Delete

    'Switch error handling back on
    On Error GoTo CreateMMMacroMenu_Error

    ' Create a new CommandBar
    Set myCB = CommandBars.Add(Name:="MMMacroMenu", Position:=msoBarFloating)

    ' Add popup menu 1 to this bar - this is a menu that folds out
    Set myCPup1 = myCB.Controls.Add(Type:=msoControlPopup)
    With myCPup1
        .Caption = "Useful Macro's"
    End With

    ' Add button 1 to popup menu 1 - "Quick and Dirty Export" macro
    Set myCP1Btn1 = myCPup1.Controls.Add(Type:=msoControlButton)
    With myCP1Btn1
     .Caption = "Export Delimited text File (Quick and dirty)"
     .Style = msoButtonIconAndCaption   'Make button show caption text and icon
     .OnAction = "ExportCurrentSheetAll"    'Macro to be called
     .TooltipText = "Exports the entire userd range of current tab to pipe delimited text file, default name and location"
     .FaceId = 1713
    End With

    ' Add button 2 to popup menu 1 - "Export with options" macro
    Set myCP1Btn1 = myCPup1.Controls.Add(Type:=msoControlButton)
    With myCP1Btn1
     .Caption = "Export Delimited text File (With options)"
     .Style = msoButtonIconAndCaption   'Make button show caption text and icon
     .OnAction = "ExporttoFileWithoptions"    ''Macro to be called
     .TooltipText = "Will present a user form to allow customisation of the export"
     .FaceId = 1713
    End With

    ' Add button 3 to popup menu 1 - "Create SQL IN" macro
    Set myCP1Btn1 = myCPup1.Controls.Add(Type:=msoControlButton)
    With myCP1Btn1
     .Caption = "Create SQL 'IN' Statement from selected cells"
     .Style = msoButtonIconAndCaption   'Make button show caption text
     .OnAction = "ShowSQLCreateForm"    'Macro to be called
     .TooltipText = "Will present a user form to allow creation of a SQL 'IN' statement from the selected cells"
     .FaceId = 528
    End With


    'Add button 4 to popup menu 1 - "Show Used Range" macro
    Set myCP1Btn1 = myCPup1.Controls.Add(Type:=msoControlButton)
    With myCP1Btn1
     .Caption = "Show what Excel thinks is the Used range for current sheet"
     .Style = msoButtonIconAndCaption   'Make button show caption text and icon
     .OnAction = "Whats_The_UsedRange"    'Macro to be called
     .TooltipText = "Will show the 'UsedRange' of the active sheet"
     .FaceId = 8
    End With

    'Add button 5 to popup menu 1 - "Used Range report" macro
    Set myCP1Btn1 = myCPup1.Controls.Add(Type:=msoControlButton)
    With myCP1Btn1
     .Caption = "Produce 'Used range report' for active workbook"
     .Style = msoButtonIconAndCaption   'Make button show caption text and icon
     .OnAction = "UsedRangeReport"    'Macro to be called
     .TooltipText = "Will produce a text file report of the used range statistics for all of the sheets in the active workbook"
     .FaceId = 852
    End With

    'Add button 6 to popup menu 1 - "Find and copy" macro
    Set myCP1Btn1 = myCPup1.Controls.Add(Type:=msoControlButton)
    With myCP1Btn1
     .Caption = "Find and copy rows of data to a new sheet"
     .Style = msoButtonIconAndCaption   'Make button show caption text and icon
     .OnAction = "FindandCopy"    'Macro to be called
     .TooltipText = "Will present a dialogue to allow the user to search for a string in the active sheet and any rows with matching values are copied to a new sheet"
     .FaceId = 1714
    End With

    'Add button 7 to popup menu 1 - "Unhide all sheets" macro
    Set myCP1Btn1 = myCPup1.Controls.Add(Type:=msoControlButton)
    With myCP1Btn1
     .Caption = "Unhide all Sheets in active workbook"
     .Style = msoButtonIconAndCaption   'Make button show caption text and icon
     .OnAction = "UnhideAllSheets"    'Macro to be called
     .TooltipText = "Will simply attempt to unhide all sheets in the active workbook"
     .FaceId = 2125
    End With

    'Add button 8 to popup menu 1 - "ToggleWorksheet events" macro
    Set myCP1Btn1 = myCPup1.Controls.Add(Type:=msoControlButton)
    With myCP1Btn1
     .Caption = "Toggle Calcuation and worksheet events on and off"
     .Style = msoButtonIconAndCaption   'Make button show caption text and icon
     .OnAction = "UnhideAllSheets"    'Macro to be called
     .TooltipText = "Used for debugging of if code has crashed without turning these featuires back on - Dont touch this if you don't know what you are doing"
     .FaceId = 2933
    End With

    ' Show the command bar
    myCB.Visible = True

CreateMMMacroMenu_Exit:
    On Error GoTo 0
    Exit Sub

CreateMMMacroMenu_Error:
    If Application.ScreenUpdating = False Then Application.ScreenUpdating = True
    Select Case Err.Number
    Case Else
        MsgBox "An unexpected error has occured, please contact CSC DM Design with the below error details." & _
            vbCrLf & "Module = UsefulGenericCode" & _
            vbCrLf & "Procedure = CreateMMMacroMenu" & _
            vbCrLf & "Line = " & Erl & _
            vbCrLf & "Error Code = " & Str$(Err.Number) & _
            vbCrLf & "Error Text = " & Err.Description & _
            vbCrLf & vbCrLf & "", vbCritical, _
            Msgboxtitle
    End Select
    Resume CreateMMMacroMenu_Exit

End Sub