In der Größe veränderbares Userform

[xlKing]

Warum sind Userforms eigentlich immer von fixer Größe? Man kann zwar (historisch bedingt) einen WhatThis Button hinzufügen. Aber die Buttons zum Minimieren und Maximieren sowie ein in der Größe veränderbarer Rahmen fehlen. Mit folgendem Code kann man das Nachrüsten:

Code im Userform:

Code: Alles auswählen

Private Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As LongPtr, ByVal dwNewLong As LongPtr) As LongPtr
Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongPtrA" (ByVal hwnd As LongPtr, ByVal nIndex As LongPtr) As LongPtr
Private Declare PtrSafe Function ShowWindow Lib "user32.dll" (ByVal hwnd As LongPtr, ByVal nCmdShow As Long) As Long
 
 
Private Const GWL_STYLE = -16 ' Ermittelt die StandardFensterstyles
Private Const GWL_EXSTYLE = -20 'Ermittelt die erweiterten Fensterstyles
 
' einige Standard-Fensterstile
Private Const WS_POPUP = &H80000000    'Fenster ist ein Popupfenster (Standard bei Userform)
Private Const WS_CLIPSIBLINGS = &H4000000 'schneidet beim zeichnen untergordnete Fenster ab. (Standard bei Userform)
Private Const WS_OVERLAPPED = &H0
Private Const WS_SYSMENU = &H80000      'hat Menü auf Titelleiste (Standard bei Userform)
Private Const WS_THICKFRAME = &H40000
Private Const WS_CAPTION = &HC00000     'hat Titelleiste (Standard bei Userform)
Private Const WS_MAXIMIZE = &H1000000    'Fenster wird maximiert
Private Const WS_MAXIMIZEBOX = &H10000 ' Maximierenbutten des Fensters
Private Const WS_MINIMIZEBOX = &H20000 ' Minimierenbutton des Fensters


'einige erweiterte Fensterstile
Private Const WS_EX_DLGMODALFRAME = &H1 'es handelt sich um ein Dialogfenster
Private Const WS_EX_WINDOWEDGE = &H100  'Das Fenster hat eine erhöhte Kante
Private Const WS_EX_APPWINDOW = &H40000 'setzt einen Fenstereintrag auf der Taskleiste (Attribut ist bei Start gesetzt aber klappt nicht)


'einige ShowWindow-Befehle
Private Const SW_HIDE = 0  'Blendet das Fenster aus und aktiviert ein anderes Fenster.
Private Const SW_SHOWNORMAL = 1 'Aktiviert und zeigt ein Fenster an. Wenn das Fenster minimiert, maximiert oder angeordnet ist, wird es vom System auf seine
                                'ursprüngliche Größe und Position wiederhergestellt. Eine Anwendung sollte dieses Flag angeben, wenn das Fenster zum ersten Mal angezeigt wird.
Private Const SW_SHOWMINIMIZED = 2 'Aktiviert das Fenster und zeigt es als minimiertes Fenster an.
Private Const SW_SHOWMAXIMIZED = 3 'Aktiviert das Fenster und zeigt es als maximiertes Fenster an.
Private Const SW_SHOWNOACTIVATE = 4 'Zeigt ein Fenster in seiner neuesten Größe und Position an. Dieser Wert ähnelt SW_SHOWNORMAL, mit der Ausnahme, dass das Fenster nicht aktiviert ist.
Private Const SW_SHOW = 5 'Aktiviert das Fenster und zeigt es in seiner aktuellen Größe und Position an.
Private Const SW_MINIMIZE = 6 'Minimiert das angegebene Fenster und aktiviert das nächste Fenster der obersten Ebene in der Reihenfolge Z.
Private Const SW_SHOWMINNOACTIVE = 7 'Zeigt das Fenster als minimiertes Fenster an. Dieser Wert ähnelt SW_SHOWMINIMIZED, außer dass das Fenster nicht aktiviert ist.
Private Const SW_SHOWNA = 8 'Zeigt das Fenster in seiner aktuellen Größe und Position an. Dieser Wert ähnelt SW_SHOW, mit der Ausnahme, dass das Fenster nicht aktiviert ist.
Private Const SW_RESTORE = 9 'Aktiviert das Fenster und zeigt es an. Wenn das Fenster minimiert, maximiert oder angeordnet ist, wird es vom System auf seine ursprüngliche Größe und Position wiederhergestellt. Eine Anwendung sollte dieses Flag beim Wiederherstellen eines minimierten Fensters angeben.

Private Sub UserForm_Activate()
  
  Dim TmpStyles As LongPtr, TmpStyles2 As LongPtr
  Dim hwnd As LongPtr
  
  hwnd = FindWindow("ThunderDFrame", Me.Caption)
  
  Call ShowWindow(hwnd, SW_HIDE)
  
  'Aktuelle Fensterstile bekommen
  TmpStyles = GetWindowLong(hwnd, GWL_STYLE)
  TmpStyles2 = GetWindowLong(hwnd, GWL_EXSTYLE)
  
  'Neue Fensterstile setzen
  TmpStyles = TmpStyles Or WS_THICKFRAME Or WS_MINIMIZEBOX Or WS_MAXIMIZEBOX 'Or WS_MAXIMIZE
  TmpStyles2 = TmpStyles2 Or WS_EX_DLGMODALFRAME Or WS_EX_WINDOWEDGE Or WS_EX_APPWINDOW
  
  Call SetWindowLong(hwnd, GWL_EXSTYLE, TmpStyles2)
  Call SetWindowLong(hwnd, GWL_STYLE, TmpStyles)
  
  Call ShowWindow(hwnd, SW_SHOW)
 
    
End Sub

Will man nun z.B. das Userform schon maximiert starten so muss man im ersten TmpStyles noch Or WS_MAXIMIZE hinzufügen sowie im letzten ShowWindow SW_SHOW durch SW_SHOWMAXIMIZED ersetzen.

Ich gebe zu, der Code ist nicht komplett von mir. Teile davon hab ich mir aus dem Netz zusammengeklaubt. Aber ich verstehe ihn und kann ihn erklären, da ich SetWindowLong schon seit längerem benutze.

Gruß Mr. K.

[Paul1206]

Hallo xlKing,

das ist mal eine wirklich brauchbare Sache.

Ich selber neige allerdings eher dazu die Formularleiste auszublenden und dafür meinen eigenen Kram einzubauen.
Das wäre dann so:
1. Codeteil in ein allgemeines Modul

Code: Alles auswählen

#If VBA7 Then
    Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
        ByVal lpClassName As String, _
        ByVal lpWindowName As String) As LongPtr
    Declare PtrSafe Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" ( _
        ByVal Hwnd As LongPtr, _
        ByVal nIndex As LongPtr) As LongPtr
    Declare PtrSafe Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _
        ByVal Hwnd As LongPtr, _
        ByVal nIndex As LongPtr, _
        ByVal dwNewLong As LongPtr) As LongPtr
    Declare PtrSafe Function DrawMenuBar Lib "user32.dll" ( _
        ByVal Hwnd As LongPtr) As LongPtr
    Declare PtrSafe Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
        ByVal Hwnd As LongPtr, _
        ByVal wMsg As LongPtr, _
        ByVal wParam As LongPtr, _
        ByRef lParam As Any) As LongPtr
    Declare PtrSafe Function ReleaseCapture Lib "user32.dll" () As LongPtr
    Public hWndForm As LongPtr
#Else
    Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
        ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long
    Declare Function GetWindowLong Lib "user32.dll" Alias "GetWindowLongA" ( _
        ByVal hWnd As Long, _
        ByVal nIndex As Long) As Long
    Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" ( _
        ByVal hWnd As Long, _
        ByVal nIndex As Long, _
        ByVal dwNewLong As Long) As Long
    Declare Function DrawMenuBar Lib "user32.dll" ( _
        ByVal hWnd As Long) As Long
    Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" ( _
        ByVal hWnd As Long, _
        ByVal wMsg As Long, _
        ByVal wParam As Long, _
        ByRef lParam As Any) As Long
    Declare Function ReleaseCapture Lib "user32.dll" () As Long
    Public hWndForm As Long
#End If

Public Const GC_CLASSNAMEMSEXCELFORM = "ThunderDFrame"
Public Const GWL_STYLE = -16
Public Const WS_CAPTION = &HC00000
Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1

Falls man dies ins Modul des Userforms haben will, sind die Constanten +die Variable hWndForm Private zu deklarieren.

Der 2. Codeteil ins Activate vom Userform:

Code: Alles auswählen

Private Sub UserForm_Activate()
    hWndForm = FindWindow(GC_CLASSNAMEMSEXCELFORM, Me.Caption)
    If hWndForm <> 0 Then
        SetWindowLong hWndForm, GWL_STYLE, GetWindowLong(hWndForm, GWL_STYLE) And Not WS_CAPTION
        DrawMenuBar hWndForm
    End If
End Sub

Gruß Uwe

[d'r Bastler]

Moin allerseits,

thowe hat in einer PN vor einiger Zeit mal vorgeschlagen, die VBAsteleien eher als Forum der Lösungen statt als Forum der Fragen zu gestalten. Ich war seinerzeit etwas skeptisch, weil ich auf keinen Fall Menschen, die hier nach Unterstützung suchen, die Tür vor der Nase zuschlagen wollte (thowe übrigens auch nicht).

Mit Euren beiden Vorschlägen zur größenveränderlichen Userform xlking und Paul1206 blast Ihr aber genau in thowe's Horn. Und nun blase ich mal mit und habe auch noch eine Lösung gebastelt:

Man nehme eine Standard-Userform (H x B 180 x 240), einen Toggle-Button tglResize (Top x Left 120 x 130, H X B 25 x 85) und ein Label Caption "Kuckuck!" Top x Left 180 x 60)
und füge dieses Snippet in den Code der Userform ein:

Code: Alles auswählen

Option Explicit

Private Sub tglResize_Click()
If tglResize = True Then
    UserForm1.Height = 250
Else
    UserForm1.Height = 200
End If
End Sub

Nur ein Klick und schon "ruft's aus dem Wald" und auch wieder nicht. Ich nutze so etwas gerne, um z.B. ausführlichere Hilfe oder Optionen ein/aus-zu blenden.

Dieser Thread ist eine Kleinigkeit mehr zu einem Forum der Lösungen - Danke dafür! Aber alle nach Unterstützung-Suchenden sind hier mal mindestens genau so willkommen!

Herzliche Grüße