有没有办法在IDE而不是主机应用程序中显示用户表单？

Question

我在*.xlam加载项中创建了一个userform,并在IDE中创建了一个新的命令栏和按钮,但是当我单击该按钮时,用户窗体在Excel中打开,并且强制远离IDE.有没有办法在IDE而不是主机应用程序中打开用户表单而不诉诸.Net COM加载项？

以下是创建命令栏和按钮并处理按钮单击事件的代码.

Option Explicit

Public WithEvents cmdBarEvents As VBIDE.CommandBarEvents

Private Sub Class_Initialize()
    CreateCommandBar
End Sub

Private Sub Class_Terminate()
    Application.VBE.CommandBars("VBIDE").Delete
End Sub

Private Sub CreateCommandBar()

    Dim bar As CommandBar
    Set bar = Application.VBE.CommandBars.Add("VBIDE", MsoBarPosition.msoBarFloating, False, True)
    bar.Visible = True

    Dim btn As CommandBarButton
    Set btn = bar.Controls.Add(msoControlButton, , , , True)
    btn.Caption = "Show Form"
    btn.OnAction = "ShowForm"
    btn.FaceId = 59

    Set cmdBarEvents = Application.VBE.Events.CommandBarEvents(btn)

End Sub

Private Sub cmdBarEvents_Click(ByVal CommandBarControl As Object, handled As Boolean, CancelDefault As Boolean)

    CallByName Me, CommandBarControl.OnAction, VbMethod

End Sub

Public Sub ShowForm()
    Dim frm As New UserForm1
    frm.Show
End Sub

PS您可能需要这行代码来删除命令栏...

Application.VBE.CommandBars("VBIDE").Delete

Answer 1

这是另一种选择.

在您的用户表单上放置一个按钮.出于演示目的,我正在使用它

接下来将此代码放在userform中

Private Sub CommandButton1_Click()
    Unload Me
    Application.Visible = True
End Sub

接下来将其粘贴到类模块的顶部

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Dim Ret As Long, ChildRet As Long

Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, _
ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Const HWND_TOPMOST = -1
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40

最后改变你Sub ShowForm()的想法

Public Sub ShowForm()
    Dim frm As New UserForm1
    Dim Ret As Long

    frm.Show vbModeless

    Application.Visible = False

    Ret = FindWindow("ThunderDFrame", frm.Caption)

    SetWindowPos Ret, HWND_TOPMOST, 100, 100, 250, 200, _
    SWP_NOACTIVATE Or SWP_SHOWWINDOW
End Sub

这就是你得到的

编辑

更多的想法.要防止用户在用户点击笑脸时创建更多用户表单,请将其更改Sub ShowForm()为以下内容.(替代方法是禁用笑脸并在表单卸载时重新启用它？)

Public Sub ShowForm()
    Dim frm As New UserForm1
    Dim Ret As Long
    Dim formCaption As String

    '~~> Set Userform Caption
    formCaption = "Blah Blah"

    On Error Resume Next
    Ret = FindWindow("ThunderDFrame", formCaption)
    On Error GoTo 0

    '~~> If already there in an instance then exit sub
    If Ret <> 0 Then Exit Sub

    frm.Show vbModeless
    frm.Caption = formCaption

    Application.Visible = False

    Ret = FindWindow("ThunderDFrame", frm.Caption)

    SetWindowPos Ret, HWND_TOPMOST, 100, 100, 250, 200, _
    SWP_NOACTIVATE Or SWP_SHOWWINDOW
End Sub