Excel使用形式：如何隐藏应用程序，但在任务栏中有图标 [英] Excel Useform: How to hide application but have icon in the taskbar

问题描述

我想要的是Application.Visible = False，所以我的用户看不到excel /工作表，只有userform。

What I want to have is Application.Visible = False, so that my users cannot see the excel/worksheets, only the userform.

我已经通过使用这段代码来实现：

I have got this to work by using this code:

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

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

However, this only has the userform floating around in the background. My users will have other applications open, and I want them to easily change to the userform by having an icon visible on the taskbar.

我已经在线发现了以下示例，但我似乎找不到放置此代码的位置。还是很新的，所以希望我有正确的工作代码。如果我这样做，有人可以通过哪里放置它，因为当我将它粘贴到代码中时，它不起作用。

I have found the following example online, but I cannot seem to find where to place this code. Still very new to this, so hopefully I have the right code for the job. If I do, can someone talk me through where to place it, as it is not working when I paste it into my code?

（即应该在'userform '或'这个工作簿：声明等等）

(i.e. should it go under 'userform' or 'this workbook: declarations' etc. )

谢谢，

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

推荐答案

您可能会注意到，这将不会在64位版本的excel上运行。

So, as you may noticed this won't work on the 64 bit version of excel.

我通过添加条件到我从这里。

I made it compatible by adding conditionals to the code i took from here.

如果您想知道如何使API函数与64位兼容版本的Excel 这里这是一个很好的文章，将让您了解。

In case you're wondering how you can make API functions compatible with 64 bits versions of Excel here it's an excellent article that will get you through.

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

I还没有在32位版本的excel上测试过，但它应该没有问题。

I haven't tested this yet on 32 bits versions of excel but it should work without problems.

这篇关于Excel使用形式：如何隐藏应用程序，但在任务栏中有图标的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！