Discussion :

[NEC14]

Bonjour à tous,

Est-ce qu'il existe un moyen de réduire et d'agrandir un UserForm en VBa de la même manière que l'on réduit ou agrandit une fenêtre excel ou word ?
En utilisant le - ou le carré à droite en haut de la fenêtre.
J'aimerai pouvoir faire la même chose avec un UserForm.
Merci par avance

[babaothe]

salut

Oui : Zoom (à voir dans l'aide excel)

[NEC14]

J'ai trouvé une solution que je vous donne. Je l'ai testée et elle fonctionne

Dans un module mettre ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
 
Public Declare Function FindWindow& _
    Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName$, ByVal lpWindowName$)
 
Public Declare Function GetWindowLong& _
    Lib "user32" Alias "GetWindowLongA" _
    (ByVal hwnd&, ByVal nIndex&)
 
Public Declare Function SetWindowLong& _
    Lib "user32" Alias "SetWindowLongA" _
    (ByVal hwnd&, ByVal nIndex&, ByVal dwNewLong&)
 
Private Declare Function EnableWindow& _
    Lib "user32" _
    (ByVal hwnd&, ByVal fEnable&)
 
Private Declare Function CallWindowProc& _
    Lib "user32" Alias "CallWindowProcA" _
    (ByVal lpPrevWndFunc&, ByVal hwnd&, ByVal Msg&, ByVal wParam&, ByVal lParam&)
 
Public Const GWL_WNDPROC& = -4&, WM_SYSCOMMAND& = &H112&
 
Public BaseUFProc&, BaseXLProc&, AncState&
 
Function UFProc&(ByVal hwnd&, ByVal uMsg&, ByVal wParam&, ByVal lParam&)
    Dim HwndXL&
    Const SC_MINIMIZE& = &HF020&
    If uMsg = WM_SYSCOMMAND Then
            If wParam = (SC_MINIMIZE And &HFFF0&) Then
                HwndXL = FindWindow("XLMAIN", Application.Caption)
                EnableWindow HwndXL, True
                UserForm1.Hide
                AncState = Application.WindowState
                Application.WindowState = xlMinimized
                BaseXLProc = SetWindowLong(HwndXL, GWL_WNDPROC, AddressOf XLProc)
                UFProc = 1&
                Exit Function
            End If
    End If
    UFProc = CallWindowProc(BaseUFProc, hwnd, uMsg, wParam, lParam)
End Function
 
 
Function XLProc&(ByVal hwnd&, ByVal uMsg&, ByVal wParam&, ByVal lParam&)
    Const SC_MAXIMIZE& = &HF030&, _
        SC_RESTORE& = &HF120&, SC_CLOSE& = &HF060&
    If uMsg = WM_SYSCOMMAND Then
            If wParam = (SC_MAXIMIZE And &HFFF0&) Or wParam = (SC_RESTORE _
                And &HFFF0&) Or wParam = SC_CLOSE Then
                SetWindowLong hwnd, GWL_WNDPROC, BaseXLProc
                Application.WindowState = AncState
                UserForm1.Show
                XLProc = 1&
                Exit Function
            End If
    End If
    XLProc = CallWindowProc(BaseXLProc, hwnd, uMsg, wParam, lParam)
End Function

Dans le module de l'UserForm ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
Private HandleUF&
 
Private Sub UserForm_Initialize()
    Const WS_MAXIMIZEBOX& = &H10000, _
        WS_MINIMIZEBOX& = &H20000, GWL_STYLE& = -16&
    HandleUF = FindWindow(vbNullString, Me.Caption)
    SetWindowLong HandleUF, GWL_STYLE, _
        GetWindowLong(HandleUF, GWL_STYLE) Or WS_MAXIMIZEBOX Or WS_MINIMIZEBOX
    BaseUFProc = SetWindowLong(HandleUF, GWL_WNDPROC, BaseUFProc)
End Sub
 
Private Sub UserForm_Terminate()
    SetWindowLong HandleUF, GWL_WNDPROC, BaseUFProc
End Sub

A bientôt