Excel Useform: How to hide application but have icon in the taskbar

前端 未结 2 1138
后悔当初
后悔当初 2020-11-30 11:56

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:

相关标签:
2条回答
  • 2020-11-30 12:32

    Try placing this code in the userforms code module:

    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 
    

    Disclaimer: This is not my code, and was found on a forum which I don't have the link for any longer.

    0 讨论(0)
  • 2020-11-30 12:49

    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.

    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&
    

    And then use the following subroutines:

    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 haven't tested this yet on 32 bits versions of excel but it should work without problems.

    0 讨论(0)
提交回复
热议问题