VBA Tipp: Titelleiste des Anwendungsfensters verändern

Aus DBWiki
Wechseln zu: Navigation, Suche

Aufgabenstellung

Ich will die Fensterleiste des Anwendungsfensters (oder eines beliebigen anderen Fensters) verändern, also z.B. die "Schließen"-Schaltfläche entfernen.

Lösung

Das geht über die API mit dieser (ziemlich allgemein gehaltenen) Routine:

  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 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 SetWindowText Lib "user32" Alias "SetWindowTextA" _
   (ByVal hwnd As Long, ByVal lpString As String) As Long
 
  Private Const HWND_NOTOPMOST = -2
  Private Const SWP_FRAMECHANGED = &H20
  Private Const SWP_DRAWFRAME = SWP_FRAMECHANGED
  Private Const SWP_HIDEWINDOW = &H80
  Private Const SWP_NOACTIVATE = &H10
  Private Const SWP_NOCOPYBITS = &H100
  Private Const SWP_NOMOVE = &H2
  Private Const SWP_NOOWNERZORDER = &H200
  Private Const SWP_NOREDRAW = &H8
  Private Const SWP_NOREPOSITION = SWP_NOOWNERZORDER
  Private Const SWP_NOSIZE = &H1
  Private Const SWP_NOZORDER = &H4
  Private Const SWP_SHOWWINDOW = &H40
 
  Private Const WS_BORDER = &H800000
  Private Const WS_CAPTION = &HC00000  'WS_BORDER Or WS_DLGFRAME
  Private Const WS_CHILD = &H40000000
  Private Const WS_DISABLED = &H8000000
  Private Const WS_DLGFRAME = &H400000
  Private Const WS_EX_ACCEPTFILES = &H10&
  Private Const WS_EX_DLGMODALFRAME = &H1&
  Private Const WS_EX_NOPARENTNOTIFY = &H4&
  Private Const WS_EX_TOPMOST = &H8&
  Private Const WS_EX_TRANSPARENT = &H20&
  Private Const WS_GROUP = &H20000
  Private Const WS_HSCROLL = &H100000
  Private Const WS_MAXIMIZE = &H1000000
  Private Const WS_MINIMIZE = &H20000000
  Private Const WS_ICONIC = WS_MINIMIZE
  Private Const WS_OVERLAPPED = &H0&
  Private Const WS_POPUP = &H80000000
  Private Const WS_SYSMENU = &H80000
  Private Const WS_POPUPWINDOW = (WS_POPUP Or WS_BORDER Or WS_SYSMENU)
  Private Const WS_TABSTOP = &H10000
  Private Const WS_THICKFRAME = &H40000
  Private Const WS_SIZEBOX = WS_THICKFRAME
  Private Const WS_TILED = WS_OVERLAPPED
  Private Const WS_VISIBLE = &H10000000
  Private Const WS_VSCROLL = &H200000
  Private Const WS_MINIMIZEBOX = &H20000
  Private Const WS_MAXIMIZEBOX = &H10000
  Private Const MDIS_ALLCHILDSTYLES = &H1
  Private Const WS_OVERLAPPEDWINDOW = _
     (WS_OVERLAPPED Or WS_CAPTION Or WS_SYSMENU Or _
      WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX)
 
  Private Const GWL_STYLE = (-16)
  Private Const GWL_EXSTYLE = (-20)
 
Private Function SetBits(L As Long, Bitmask As Long, SetB As Boolean)
' Wenn SetB, dann Bits setzen, sonst Bits löschen
If SetB Then
  SetBits = L Or Bitmask
Else
  SetBits = L And Not Bitmask
End If
End Function
 
Public Function CaptionStyle(Optional hWndS As Long = 0, _
  Optional Caption As Boolean = True, _
  Optional SysMenu As Boolean = False, _
  Optional MinimizeBox As Boolean = True, _
  Optional MaximizeBox As Boolean = True, _
  Optional SizeBox As Boolean = True, _
  Optional Titel)
'
'   Fenstertitel modifizieren
'
 
Dim hwnd As Long, WS As Long, Ret As Long, hParent As Long
 
  hwnd = hWndS   ' Window-Handle
  If hwnd = 0 Then hwnd = Application.hWndAccessApp   ' Anwendung-Handle nehmen
  WS = GetWindowLong(hwnd, GWL_STYLE)         ' Style holen
  WS = SetBits(WS, WS_SYSMENU, SysMenu)
  WS = SetBits(WS, WS_MINIMIZEBOX, MinimizeBox)
  WS = SetBits(WS, WS_MAXIMIZEBOX, MaximizeBox)
  WS = SetBits(WS, WS_SIZEBOX, SizeBox)
  WS = SetBits(WS, WS_CAPTION, Caption)
  If Not IsMissing(Titel) Then SetWindowText hwnd, Titel
  SetWindowLong hwnd, GWL_STYLE, WS ' Style setzen
 
' Window neu aufbauen
  SetWindowPos hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, _
    SWP_NOZORDER Or SWP_NOSIZE Or SWP_NOMOVE Or SWP_DRAWFRAME
 
End Function

Aufruf

' Fenstertitel eines Formulars ändern:
CaptionStyle Me.hwnd,True,True,True,True,True,"Nur ein Test"
 
' Titelleiste der Anwendung vollständig entfernen:
CaptionStyle ,False,False,False,False,False