Vba Excel Useform：如何隐藏应用程序但在任务栏中有图标

我想要的是Application.Visible=False，这样我的用户就不能看到excel/工作表，只能看到userform

我通过使用以下代码实现了这一点：

Private Sub Workbook_Open()
Application.Visible = False
UserForm2.Show
End Sub

但是，这只会使userform在后台浮动。我的用户将打开其他应用程序，我希望他们通过在任务栏上显示一个图标来轻松更改为userform

我在网上找到了下面的示例，但我似乎找不到放置此代码的位置。还是很新的，所以希望我有正确的工作代码。如果我这样做了，有人能告诉我在哪里放置它吗，因为当我将它粘贴到代码中时它不起作用

（即，是否应归入“用户表单”或“本工作簿：声明”等）

谢谢,

Option Explicit
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetFocus Lib "user32" (ByVal hWnd As Long) As Long
Private Const GWL_STYLE As Long = -16
Private Const GWL_EXSTYLE As Long = -20
Private Const WS_CAPTION As Long = &HC00000
Private Const WS_MINIMIZEBOX As Long = &H20000
Private Const WS_MAXIMIZEBOX As Long = &H10000
Private Const WS_POPUP As Long = &H80000000
Private Const WS_VISIBLE As Long = &H10000000
Private Const WS_EX_DLGMODALFRAME As Long = &H1
Private Const WS_EX_APPWINDOW As Long = &H40000
Private Const SW_SHOW As Long = 5

Private Sub UserForm_Activate()
Application.Visible = False
Application.VBE.MainWindow.Visible = False
    Dim lngHwnd As Long
    Dim lngCurrentStyle As Long, lngNewStyle As Long
    If Val(Application.Version) < 9 Then
        lngHwnd = FindWindow("ThunderXFrame", Me.Caption)  'XL97
    Else
        lngHwnd = FindWindow("ThunderDFrame", Me.Caption)  'XL2000, XP, 2003?
    End If
    'Set the Windows style so that the userform has a minimise and maximise button
    lngCurrentStyle = GetWindowLong(lngHwnd, GWL_STYLE)
    lngNewStyle = lngCurrentStyle Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
    lngNewStyle = lngNewStyle And Not WS_VISIBLE And Not WS_POPUP
    SetWindowLong lngHwnd, GWL_STYLE, lngNewStyle

    'Set the extended style to provide a taskbar icon
    lngCurrentStyle = GetWindowLong(lngHwnd, GWL_EXSTYLE)
    lngNewStyle = lngCurrentStyle Or WS_EX_APPWINDOW
    SetWindowLong lngHwnd, GWL_EXSTYLE, lngNewStyle
    ShowWindow lngHwnd, SW_SHOW
End Sub
Private Sub UserForm_Terminate()
Application.Visible = True
End Sub

选项显式
私有声明函数GetWindowLong Lib“user32”别名“GetWindowLongA”（ByVal hWnd为Long，ByVal nIndex为Long）为Long
私有声明函数ShowWindow Lib“user32”（ByVal hWnd为Long，ByVal nCmdShow为Long）为Long
私有声明函数findwindowlib“user32”别名“FindWindowA”（ByVal lpClassName作为字符串，ByVal lpWindowName作为字符串），长度为
私有声明函数SetWindowLong Lib“user32”别名“SetWindowLongA”（ByVal hWnd为Long，ByVal nIndex为Long，ByVal dwNewLong为Long）为Long
私有声明函数SetFocus Lib“user32”（ByVal hWnd作为Long）作为Long
Private Const GWL_样式，长度=-16
私有常量GWL_EXSTYLE长度=-20
Private Const WS_标题长度=&HC00000
私有Const WS_MINIMIZEBOX的长度=&H20000
私有Const WS_MAXIMIZEBOX长度=&H10000
私有常量WS_弹出窗口长度=&H8000000
Private Const WS_显示为Long=&h1000000
私有Const WS_EX_DLGMODALFRAME As Long=&H1
私有常量WS_EX_APPWINDOW As Long=&H40000
私人施工开关显示长度=5
私有子用户表单_Activate（）
Application.Visible=False
Application.VBE.MainWindow.Visible=False
暗淡无光
暗lngCurrentStyle等长，lngNewStyle等长
如果Val（Application.Version）<9，则
lngHwnd=FindWindow（“ThunderXFrame”，Me.Caption）”XL97
其他的
lngHwnd=FindWindow（“ThunderDFrame”，Me.Caption）”XL2000，XP，2003？
如果结束
'设置Windows样式，以便userform具有最小化和最大化按钮
lngCurrentStyle=GetWindowLong（lngHwnd，GWL_样式）
lngNewStyle=lngCurrentStyle或WS_MINIMIZEBOX或WS_MAXIMIZEBOX
lngNewStyle=lngNewStyle且不可见且不弹出
SetWindowLong lngHwnd，GWL_样式，lngNewStyle
'设置扩展样式以提供任务栏图标
lngCurrentStyle=GetWindowLong（lngHwnd，GWL_EXSTYLE）
lngNewStyle=lngCurrentStyle或WS_EX_APPWINDOW
SetWindowLong lngHwnd，GWL_EXSTYLE，lngNewStyle
展示窗口入口，西南展示
端接头
私有子用户表单_Terminate（）
Application.Visible=True
端接头

尝试将此代码放在userforms代码模块中：

Option Explicit

'API functions
Private Declare Function GetWindowLong Lib "user32" _
                                       Alias "GetWindowLongA" _
                                      (ByVal hwnd As Long, _
                                        ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" _
                                       Alias "SetWindowLongA" _
                                       (ByVal hwnd As Long, _
                                        ByVal nIndex As Long, _
                                        ByVal dwNewLong As Long) 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 Declare Function FindWindow Lib "user32" _
                                    Alias "FindWindowA" _
                                    (ByVal lpClassName As String, _
                                     ByVal lpWindowName As String) As Long
Private Declare Function GetActiveWindow Lib "user32.dll" _
                                         () As Long
Private Declare Function SendMessage Lib "user32" _
                                     Alias "SendMessageA" _
                                     (ByVal hwnd As Long, _
                                      ByVal wMsg As Long, _
                                      ByVal wParam As Long, _
                                      lParam As Any) As Long
Private Declare Function DrawMenuBar Lib "user32" _
                                     (ByVal hwnd As Long) As Long



'Constants
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const GWL_EXSTYLE = (-20)
Private Const HWND_TOP = 0
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
Private Const WS_EX_APPWINDOW = &H40000
Private Const GWL_STYLE = (-16)
Private Const WS_MINIMIZEBOX = &H20000
Private Const SWP_FRAMECHANGED = &H20
Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&

Private Sub AppTasklist(myForm)

'Add this userform into the Task bar
    Dim WStyle As Long
    Dim Result As Long
    Dim hwnd As Long
    hwnd = FindWindow(vbNullString, myForm.Caption)
    WStyle = GetWindowLong(hwnd, GWL_EXSTYLE)
    WStyle = WStyle Or WS_EX_APPWINDOW
    Result = SetWindowPos(hwnd, HWND_TOP, 0, 0, 0, 0, _
                          SWP_NOMOVE Or _
                          SWP_NOSIZE Or _
                          SWP_NOACTIVATE Or _
                          SWP_HIDEWINDOW)
    Result = SetWindowLong(hwnd, GWL_EXSTYLE, WStyle)
    Result = SetWindowPos(hwnd, HWND_TOP, 0, 0, 0, 0, _
                          SWP_NOMOVE Or _
                          SWP_NOSIZE Or _
                          SWP_NOACTIVATE Or _
                          SWP_SHOWWINDOW)

End Sub

Private Sub UserForm_Activate()

Application.Visible = False
Application.VBE.MainWindow.Visible = False
AppTaskList Me

End Sub

Private Sub UserForm_Terminate()

Application.Visible = True

End Sub 

---

免责声明：这不是我的代码，是在一个我已经没有链接的论坛上找到的。

因此，您可能注意到，这在64位版本的excel上不起作用

我通过向从中获取的代码添加条件使其兼容

如果您想知道如何使API函数与64位版本的Excel兼容，这是一篇很好的文章，可以帮助您完成

Option Explicit

'API functions
#If VBA7 Then

    #If Win64 Then
        Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongPtrA" _
            (ByVal hWnd As LongPtr, _
             ByVal nIndex As Long _
            ) As LongPtr
    #Else
        Private Declare PtrSafe Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" _
            (ByVal hWnd As LongPtr, _
             ByVal nIndex As Long _
            ) As LongPtr
    #End If

    #If Win64 Then
        Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongPtrA" _
            (ByVal hWnd As LongPtr, _
             ByVal nIndex As Long, _
             ByVal dwNewLong As LongPtr _
            ) As LongPtr
    #Else
        Private Declare PtrSafe Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" _
            (ByVal hWnd As LongPtr, _
             ByVal nIndex As Long, _
             ByVal dwNewLong As LongPtr _
            ) As LongPtr
    #End If

    Private Declare PtrSafe Function SetWindowPos Lib "user32" _
        (ByVal hWnd As LongPtr, _
         ByVal hWndInsertAfter As LongPtr, _
         ByVal X As Long, ByVal Y As Long, _
         ByVal cx As Long, ByVal cy As Long, _
         ByVal wFlags As Long _
        ) As LongPtr
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
        (ByVal lpClassName As String, _
         ByVal lpWindowName As String _
        ) As LongPtr
    Private Declare PtrSafe Function GetActiveWindow Lib "user32.dll" () As Long
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hWnd As LongPtr, _
         ByVal wMsg As Long, _
         ByVal wParam As Long, _
         lParam As Any _
        ) As LongPtr
    Private Declare PtrSafe Function DrawMenuBar Lib "user32" _
        (ByVal hWnd As LongPtr) As LongPtr

#Else

    Private Declare Function GetWindowLongPtr Lib "user32" Alias "GetWindowLongA" _
        (ByVal hWnd As Long, _
         ByVal nIndex As Long _
        ) As Long
    Private Declare Function SetWindowLongPtr Lib "user32" Alias "SetWindowLongA" _
        (ByVal hWnd As Long, _
         ByVal nIndex As Long, _
         ByVal dwNewLong As Long _
        ) 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 Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
        (ByVal lpClassName As String, _
         ByVal lpWindowName As String _
        ) As Long
    Private Declare Function GetActiveWindow Lib "user32.dll" () As Long
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hWnd As Long, _
         ByVal wMsg As Long, _
         ByVal wParam As Long, _
         lParam As Any _
        ) As Long
    Private Declare Function DrawMenuBar Lib "user32" _
        (ByVal hWnd As Long) As Long

#End If


'Constants
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const GWL_EXSTYLE = (-20)
Private Const HWND_TOP = 0
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_HIDEWINDOW = &H80
Private Const SWP_SHOWWINDOW = &H40
Private Const WS_EX_APPWINDOW = &H40000
Private Const GWL_STYLE = (-16)
Private Const WS_MINIMIZEBOX = &H20000
Private Const SWP_FRAMECHANGED = &H20
Private Const WM_SETICON = &H80
Private Const ICON_SMALL = 0&
Private Const ICON_BIG = 1&

然后使用以下子例程：

Private Sub UserForm_Activate()
    AddIcon    'Add an icon on the titlebar
    AddMinimizeButton   'Add a Minimize button to Userform
    AppTasklist Me    'Add this userform into the Task bar
End Sub

Private Sub AddIcon()
'Add an icon on the titlebar
    Dim hWnd As Long
    Dim lngRet As Long
    Dim hIcon As Long
    hIcon = Sheet1.Image1.Picture.Handle
    hWnd = FindWindow(vbNullString, Me.Caption)
    lngRet = SendMessage(hWnd, WM_SETICON, ICON_SMALL, ByVal hIcon)
    lngRet = SendMessage(hWnd, WM_SETICON, ICON_BIG, ByVal hIcon)
    lngRet = DrawMenuBar(hWnd)
End Sub

Private Sub AddMinimizeButton()
'Add a Minimize button to Userform
    Dim hWnd As Long
    hWnd = GetActiveWindow
    Call SetWindowLongPtr(hWnd, GWL_STYLE, _
                       GetWindowLongPtr(hWnd, GWL_STYLE) Or _
                       WS_MINIMIZEBOX)
    Call SetWindowPos(hWnd, 0, 0, 0, 0, 0, _
                      SWP_FRAMECHANGED Or _
                      SWP_NOMOVE Or _
                      SWP_NOSIZE)
End Sub

Private Sub AppTasklist(myForm)
'Add this userform into the Task bar
    #If VBA7 Then
        Dim WStyle As LongPtr
        Dim Result As LongPtr
        Dim hWnd As LongPtr
    #Else
        Dim WStyle As Long
        Dim Result As Long
        Dim hWnd As Long
    #End If

    hWnd = FindWindow(vbNullString, myForm.Caption)
    WStyle = GetWindowLongPtr(hWnd, GWL_EXSTYLE)
    WStyle = WStyle Or WS_EX_APPWINDOW
    Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
                          SWP_NOMOVE Or _
                          SWP_NOSIZE Or _
                          SWP_NOACTIVATE Or _
                          SWP_HIDEWINDOW)
    Result = SetWindowLongPtr(hWnd, GWL_EXSTYLE, WStyle)
    Result = SetWindowPos(hWnd, HWND_TOP, 0, 0, 0, 0, _
                          SWP_NOMOVE Or _
                          SWP_NOSIZE Or _
                          SWP_NOACTIVATE Or _
                          SWP_SHOWWINDOW)
End Sub

---

我还没有在32位版本的excel上对此进行测试，但它应该可以正常工作。

感谢您的解决方案。我得到了以下编译错误：“只有注释可以出现在End子、End函数或End属性之后”。在添加您的代码之前，我没有这个错误。我也删除了你代码中的所有注释，但仍然没有，有什么想法吗？我刚刚测试了它，它对我有效。请确保将其放在模块顶部，并且不要重复

Option Explicit

语句。我已经将我的代码弄得一团糟，试图让它正常工作。我将尝试重新检查它，以确保我没有任何让它混淆的东西（因此感谢您的测试）。你能跟我确认一下你所说的“使用表单代码模块”是什么意思吗。我应该把它放在tabs用户窗体下并激活吗？或者我应该创建一个新模块？抱歉，太生疏了。右键单击Project Explorer窗口中的用户窗体，选择“查看代码”，然后将代码粘贴到其中。谢谢你——我意识到我犯了一些愚蠢的内务管理错误。这就是它不起作用的原因。谢谢大家，top marks。这将在64位版本上引发类型不匹配，其中

FindWindow

返回

LongPtr

，但在

AddIcon

中，

hWnd

声明为

Long

，而不是

LongPtr