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

Question

我在 *.xlam 加载项中创建了一个用户表单，并在 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

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

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

Answer 1

这是一个替代方案。

在您的用户表单上放置一个按钮。出于演示目的，我正在使用这个



接下来将此代码放入用户表单中

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

接下来将其粘贴到您的类(class)模块顶部

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