Excel使用forms：如何隐藏应用程序，但在任务栏中有图标
我想要的是Application.Visible = False，以便我的用户不能看到Excel /工作表，只有用户窗体。
我有这个工作，通过使用这个代码：
Private Sub Workbook_Open() Application.Visible = False UserForm2.Show End Sub 但是，这只有在后台浮动的用户表单。 我的用户将打开其他应用程序，我希望他们可以通过在任务栏上显示一个图标轻松地更改为用户窗体。
我在网上find了下面的例子，但我似乎无法find放置这个代码的地方。 对此还是很新的，所以希望我有正确的工作代码。 如果我这样做，是否可以有人跟我说说把它放在哪里，因为当我把它粘贴到我的代码中时，它不工作？
（即它应该在“用户表单”或“这个工作簿：声明”之下）
谢谢，
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。
我通过在我从这里取的代码添加条件来使它兼容。
如果您想知道如何使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
我还没有testing这个在32位版本的Excel，但它应该没有问题。
尝试把这个代码放在用户代码模块中：
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
免责声明：这不是我的代码，并发现在一个论坛上，我没有链接了。