Userform: Icon in Taskleiste anzeigen

[volti]

Liebe Leserin, lieber Leser,

manchmal besteht der Wunsch, dass eine Userform alleinig, also mit ausgeblendetem Excel auf dem Bildschirm angezeigt wird.
Schön wäre es dann auch, wenn in der Titlebar der Userform ein individuelles Icon angezeigt würde.
Hierzu gibt es sicher schon viele Beispiele im Netz.

Schwieriger wird es schon, wenn die Userform mit dem Icon auch in der Taskleiste angezeigt werden soll.
Als Childwindow der Excelanwendung wird die Userform wie alle anderen offenen Mappen nur unter dem Excel-Icon angezeigt.

Mit dem nachfolgenden Code-Beispiel kannst Du Deine Userform mit folgenden Eigenschaften ausstatten:

• Minimierungsbutton in der Titelleiste zum Minimieren der Userform
• Individuelles Icon in der Titelleiste der Userform
• Alternativ: Komplettes Abschalten der Titelleiste
• Icon der Userform in der Taskleiste als zusätzlicher Button incl. ToolTip
• Userform immer im Vordergrund
• Ausblenden des VBA-Editors während der Userformanzeige
• Ausblenden des Excel-Icons in der Taskleiste

PS: Das Ein- und Ausblenden der Userform kann auch ohne Minimierungsbutton in der Titelleiste durch Klick auf das Taskleistenicon erfolgen.

Hinweis: Leider wird bei meiner XL-64-Version das Excel-Icon nicht entfernt, das erfolgt nur bei der XL-32-Version. Ist das bei anderen Nutzern auch so?

Dieser Code ist nur ein Beispiel. Damit der Code klein bleibt, wurde auf per Parameter einstellbare Alternativen verzichtet.
So ist es aber nach Codeanpassung u.a. natürlich möglich, das Icon aus einer ICO-, EXE- oder DLL-Datei zu holen oder die allwaysOnTop-Einstellung abzuschalten.

  Userform_Icon_In_Taskleiste.xlsb (Größe: 37,24 KB / Downloads: 11)

Und nun viel Spaß und Erfolg damit.

Code:

Option Explicit

' UserForm-Icon in Taskleiste und Minimieren im Rahmen
#If Win64 Then
    Private Declare PtrSafe Function GetWindowLongA Lib "user32.dll" _
            Alias "GetWindowLongPtrA" ( _
            ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
    Private Declare PtrSafe Function SetWindowLongA Lib "user32.dll" _
            Alias "SetWindowLongPtrA" ( _
            ByVal hWnd As LongPtr, ByVal nIndex As Long, _
            ByVal dwNewLong As LongPtr) As LongPtr
    Private Const ciFakt = 2
#Else
    Private Declare PtrSafe Function GetWindowLongA Lib "user32.dll" ( _
            ByVal hWnd As LongPtr, ByVal nIndex As Long) As LongPtr
    Private Declare PtrSafe Function SetWindowLongA Lib "user32.dll" ( _
            ByVal hWnd As LongPtr, ByVal nIndex As Long, _
            ByVal dwNewLong As LongPtr) As LongPtr
    Private Const ciFakt = 1
#End If

Private Const ciInitTab As Long = 12 * ciFakt
Private Const ciAddTab  As Long = 16 * ciFakt
Private Const ciActTab  As Long = 24 * ciFakt
Private Const ciDelTab  As Long = 20 * ciFakt
Private Const ciToolTip As Long = 76 * ciFakt
Private Const ciSetVal  As Long = 24 * ciFakt
Private Const ciCommit  As Long = 28 * ciFakt

Private Declare PtrSafe Function FindWindowA Lib "user32.dll" ( _
        ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function SendMessageA Lib "user32.dll" ( _
        ByVal hWnd As LongPtr, ByVal wMsg As Long, _
        ByVal wParam As LongPtr, ByVal lParam As Any) As LongPtr
Private Declare PtrSafe Function ShowWindow Lib "user32.dll" ( _
        ByVal hWnd As LongPtr, ByVal nCmdShow As Long) As Long
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 Long
Private Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hWnd As LongPtr) As Long
Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As LongPtr) As Long
Private Declare PtrSafe Function DispCallFunc Lib "oleAut32.dll" ( _
        ByVal pvInstance As LongPtr, ByVal offsetinVft As LongPtr, ByVal CallConv As Long, _
        ByVal retTYP As Integer, ByVal paCNT As Long, ByRef paTypes As Integer, _
        ByRef paValues As LongPtr, ByRef retVAR As Variant) As Long
Private Declare PtrSafe Function CoCreateInstance Lib "ole32" ( _
        ByRef rclsid As GUID, ByVal pUnkOuter As LongPtr, ByVal dwClsContext As Long, _
        ByRef riid As GUID, ByRef ppv As LongPtr) As Long
Private Declare PtrSafe Function CLSIDFromString Lib "ole32" ( _
        ByVal OleStringCLSID As LongPtr, ByRef cGUID As Any) As Long
Private Declare PtrSafe Function SHGetPropertyStoreForWindow Lib "Shell32.dll" ( _
        ByVal hWnd As LongPtr, ByRef riid As GUID, ByRef ppv As LongPtr) As Long

Private Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(0 To 7) As Byte
End Type
Dim tClsID As GUID, tIID As GUID

Private Type PROPERTYKEY
   fmtid As GUID
   pid   As Long
End Type
Dim tPK As PROPERTYKEY

Dim mhWndUF   As LongPtr, mhVBE As LongPtr                  ' Handle Userform und VBE-Editor
Dim lpBarList As LongPtr, lpStore As LongPtr
Dim mbVBE     As Boolean

Private Sub UserForm_Initialize()
  Const GWL_HWNDPARENT = (-8)
  Const GWL_STYLE = -16&
  Const WS_CAPTION = &HC00000                               ' <<<<< Nur für Caption weg >>>>>
  Const WS_MINIMAXIMIZEBOX = &H20000 '&H30000               ' WS_MINIMIZEBOX Or WS_MAXIMIZEBOX
  Const HWND_TOPMOST = -1                                   ' Userform allways on top
  Const WM_SETICON = &H80
  Dim hIcon As LongPtr
  
' <<<<< Hier Icon vorgeben oder mit LoadIcon aus Datei holen >>>>>
  hIcon = Image1.Picture.Handle                             ' Handle für Icon aus UF nehmen
' hIcon = Tabelle1.Image1.Picture.Handle                    ' Handle für Icon aus Sheet nehmen
  mhVBE = FindWindowA("wndclass_desked_gsk", vbNullString)  ' Handle des VBE-Editor holen
  mhWndUF = FindWindowA("ThunderDFrame", Caption)           ' Handle der Userform holen
  SetWindowLongA mhWndUF, GWL_STYLE, GetWindowLongA(mhWndUF, GWL_STYLE) _
                          Or WS_MINIMAXIMIZEBOX             ' Mini/Maxiboxen zufügen
' SetWindowLongA mhWndUF, GWL_STYLE, GetWindowLongA(mhWndUF, GWL_STYLE) _
                          And Not WS_CAPTION '              ' <<<<< Nur für Caption weg >>>>>
' DrawMenuBar mhWndUF                                       ' <<<<< Nur für Caption weg >>>>>
  SendMessageA mhWndUF, WM_SETICON, 0&, hIcon               ' Icon in Caption setzen
  SetWindowLongA mhWndUF, GWL_HWNDPARENT, 0                 ' Das Elternfenster der Userform entfernen
  SetWindowPos mhWndUF, HWND_TOPMOST, 0, 0, 0, 0, &H3       ' UF immer im Vordergrund <<<<< ggf. rausnehmen  >>>>>
  Application.Visible = False                               ' Excel anzeigen aus
  SetTaskBar "Dialogbox " & Caption & " wieder aktivieren"  ' <<<<< ToopTip ggf. anpassen >>>>>
End Sub

Private Sub SetTaskBar(Optional sToolTip As String)
' Teile von Jaafar Tribak verwendet
  Const IID_PropertyStore = "{886D8EEB-8CF2-4446-8D02-CDBA1DBDCF99}"
  Const IID_PropertyKey = "{9F4C2855-9F79-4B39-A8D0-E1D42DE1D5F3}"
  Const CLSID_TASKLIST = "{56FDF344-FD6D-11D0-958A-006097C9A090}"
  Const IID_TASKLIST = "{EA1AFB91-9E28-4B86-90E9-9E9F8A5EEFAF}"
  Const CLSCTX_INPROC_SERVER = &H1
  Const S_OK = 0
  
  Call CLSIDFromString(StrPtr(IID_PropertyStore), tIID)
  If SHGetPropertyStoreForWindow(mhWndUF, tIID, lpStore) = S_OK Then
      Call CLSIDFromString(StrPtr(IID_PropertyKey), tPK)
      #If Win64 Then
          Dim PV(2) As LongPtr
          PV(1) = StrPtr("Dummy")
      #Else
          Dim PV(3) As LongPtr
          PV(2) = StrPtr("Dummy")
      #End If
      tPK.pid = 5: PV(0) = 31
      SetTabList 0, ciSetVal, VarPtr(tPK), VarPtr(PV(0))    ' SetValue Methode
      SetTabList 0, ciCommit                                ' Commit Methode ggf. überflüssig

      Call CLSIDFromString(StrPtr(CLSID_TASKLIST), tClsID)
      Call CLSIDFromString(StrPtr(IID_TASKLIST), tIID)
      If CoCreateInstance(tClsID, 0, CLSCTX_INPROC_SERVER, tIID, lpBarList) = S_OK Then
         SetTabList 1, ciInitTab                            ' Tab initialisieren
         SetTabList 1, ciAddTab, mhWndUF                    ' Tab Userform zufügen
         SetTabList 1, ciActTab, mhWndUF                    ' Tab Userform aktivieren
         If Len(sToolTip) Then _
         SetTabList 1, ciToolTip, mhWndUF, StrPtr(sToolTip) ' ToolTip hinzufügen
' VBE-Editor ausblenden
         If IsWindowVisible(mhVBE) Then                     ' Nur wenn sichtbar
            ShowWindow mhVBE, 0 ' 0 = SW_HIDE               ' VBE-Editor ausblenden
            SetTabList 1, ciDelTab, mhVBE                   ' Tab VBE-Editor löschen
            mbVBE = True
         End If
         SetTabList 1, ciDelTab, Application.hWnd           ' Tab Excel-Application löschen
      End If
  End If
  
End Sub

Private Sub ResetTaskbar()
' Bereinigen der Taskleiste
  SetTabList 1, ciDelTab, mhWndUF                           ' Tab Userform löschen
  If mbVBE Then                                             ' (optional)
     SetTabList 1, ciAddTab, mhVBE                          ' Tab VBE-Editor zufügen
     ShowWindow mhVBE, 5  ' 5 = SW_SHOW                     ' VBE-Editor wieder anzeigen
  End If
  SetTabList 1, ciAddTab, Application.hWnd                  ' Tab Excel-Application zufügen
End Sub

Private Sub SetTabList(iPtArt As Integer, iTblOffs As Long, ParamArray vFuncParams() As Variant)
' Setzen der Taskleiste mit den gewünschten Elementen
' Teile von Jaafar Tribak verwendet
  Const CC_STDCALL = 4
  Dim vParamPtr()  As LongPtr, hInst As LongPtr
  Dim vParamType() As Integer
  Dim vRtn         As Variant
  Dim vParams()    As Variant
  Dim iMax As Long, i As Long
  
  vParams() = vFuncParams()
  iMax = Abs(UBound(vParams) - LBound(vParams) + 1&)
  If iMax = 0& Then
     ReDim vParamPtr(0 To 0)
     ReDim vParamType(0 To 0)
  Else
     ReDim vParamPtr(0 To iMax - 1&)
     ReDim vParamType(0 To iMax - 1&)
     For i = 0& To iMax - 1&
         vParamPtr(i) = VarPtr(vParams(i))
         vParamType(i) = VarType(vParams(i))
     Next i
  End If

  hInst = IIf(iPtArt = 1, lpBarList, lpStore)
  DispCallFunc hInst, iTblOffs, CC_STDCALL, vbLong, iMax, vParamType(0), vParamPtr(0), vRtn
End Sub


Private Sub UserForm_Terminate()
  ResetTaskbar
  Application.Visible = True
End Sub


' ----------- Userform beeenden ----------
Private Sub CommandButton1_Click()
  Unload Me
End Sub

_________
viele Grüße
Karl-Heinz