Userform mit WhatThis-Button

Userformen bieten standardmäßig keinen WhatThis-Button. Mit ein paar API-Funktionen kann man den Fensterstil so ändern, dass das Fragezeichen in der Titelleiste erscheint.

Leider gibt es auch keine Ereignisprozedur, die beim Anklicken ausgeführt wird. Mit der API WinHelp kann eine Hilfedatei angegeben werden, aber etwas anderes geht unter normalen Umständen nicht.

Um dem abzuhelfen, muss man dazu die Fensternachrichten abhören und bei der richtigen Nachricht reagieren. Excel ist zwar nicht gerade die erste Wahl für solch ein Subclassing, aber bei einem flotten Rechner sollte das ohne Probleme funktionieren.

Die Funktion, auf die die Fensternachrichten umgeleitet wird, muss sich in einem Standardmodul befinden. Jede Unterbrechung dort, oder jeder unbehandelte Fehler können fatale Folgen haben.

Beispieldatei (WhatThis.zip 24 kB) 

In ein allgemeines Modul:

Option Explicit
Private Declare Function CallWindowProc _
   Lib "user32" Alias "CallWindowProcA" ( _
   ByVal lpPrevWndFunc As Long, _
   ByVal hWnd As Long, _
   ByVal Msg As Long, _
   ByVal wParam As Long, _
   ByVal lParam As Long _
   ) As Long

Private Const WM_SYSCOMMAND = &H112
Private Const SC_CONTEXTHELP = &HF180&

Public glngOldProc         As Long

Public Function NewProc(ByVal hWnd As Long, ByVal Msg As Long, _
   ByVal wParam As Long, ByVal lParam As Long _
   ) As Long
   If Msg = WM_SYSCOMMAND Then
      If wParam = SC_CONTEXTHELP Then
         MsgBox "'Hilfe' gewählt"
         ' CallWindowProc weggelassen,
         ' damit der Mauscursor nicht
         ' verändert wird
      Else
         NewProc = CallWindowProc( _
            glngOldProc, hWnd, Msg, wParam, lParam)
      End If
   Else
      NewProc = CallWindowProc( _
         glngOldProc, hWnd, Msg, wParam, lParam)
   End If
End Function

In eine Userform mit dem Namen WhatThis:

Option Explicit
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 FindWindow _
   Lib "user32" Alias "FindWindowA" ( _
   ByVal lpClassName As String, _
   ByVal lpWindowName As String _
   ) As Long
Private Declare Function DrawMenuBar _
   Lib "user32" ( _
   ByVal hWnd As Long _
   ) As Long

Private Const HELP_CONTEXTPOPUP = &H8
Private Const WS_EX_CONTEXTHELP = &H400

Private Const GWL_WNDPROC = (-4)
Private Const GWL_EXSTYLE = (-20)

Private mlngForm As Long

Private Sub MinMaxMenu()
   Dim lngStyle As Long
   
   ' Fensterstil ändern
   lngStyle = GetWindowLong(mlngForm, GWL_EXSTYLE)
   lngStyle = WS_EX_CONTEXTHELP
   SetWindowLong mlngForm, GWL_EXSTYLE, lngStyle
   DrawMenuBar mlngForm
   
   ' WindowProc umleiten
   glngOldProc = SetWindowLong(mlngForm, _
      GWL_WNDPROC, AddressOf NewProc)
      
End Sub

Private Sub UserForm_Terminate()
   SetWindowLong mlngForm, GWL_WNDPROC, glngOldProc
End Sub

Private Sub UserForm_Initialize()
   mlngForm = GetMyHandle()
   MinMaxMenu
End Sub

 Private Function GetMyHandle() As Long
   Dim strMe   As String
   Dim strFind As String
   
   ' Liefert das Handle der Userform
   strFind = "asdfghjk"
   strMe = Me.Caption
   Me.Caption = strFind
   GetMyHandle = FindWindow(vbNullString, Me.Caption)
   Me.Caption = strMe
End Function