redimensionner la taille de l'userform après agrandissement ou réduction

**Mr l'Ashanti** · 14/06/2023, 08h10

Bonjour forum
je viens par cette fenêtre vous soumettre un petit sujet qui jusqu'à présent me fatigue.
j'ai un userfom que je redimensionne grâce aux boutons agrandir et réduire qui se trouve sur la fenêtre d'affichage. le problème ici est que je peux redimensionner la taille des objets se trouvant sur l' userform lorsque je mets le code dans le module d'un contrôle

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
 
Sub TailleUserform()
Dim ctl As Control
Dim Larg As Integer
Dim Haut As Integer
 
Larg = Application.Width / Me.Width
Haut = Application.Height / Me.Height
Me.Left = 0
Me.Top = 0
Me.Width = Application.WindowState
Me.Height = Application.WindowState
For Each ctl In Me.Controls
  ctl.Left = ctl.Left * Larg
  ctl.Top = ctl.Top * Haut
  ctl.Width = ctl.Width * Larg
  ctl.Height = ctl.Height * Haut
'  ctl.Font.Size = ctl.Font.Size * Larg
Next
End Sub

pour que cela puisse se faire auto lorsque j'agrandis ou réduis la taille de l'userform, j'ai donc mis la procédure dans l'évènement Userform_Resize() mais lors du redimensionnement j'ai ce message en image Nom : SharedScreensho sendt.jpg
Affichages : 427
Taille : 18,1 Ko

Nom : SharedScreensho sendt.jpg
Affichages : 427
Taille : 18,1 Ko

et les lignes de codes

Code :

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

1
2
3
4
Me.Left = 0
Me.Top = 0
Me.Width = Application.WindowState
Me.Height = Application.WindowState

sont soulignées.

je mets les données de mon module pour que vous compreniez

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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
Option Explicit
'----------Private Function (PtrSafe for Windows x86)-------------------------------------
Private Declare PtrSafe Function StartWindow Lib "User32" Alias "GetWindowLongA" ( _
    ByVal hWnd As Long, ByVal nIndex As Long) As Long
 
Private Declare PtrSafe Function MoveWindow Lib "User32" Alias "SetWindowLongA" ( _
    ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
 
Private Declare PtrSafe Function FindWindowA Lib "User32" (ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long
 
Private Const CURRENT_SIZE As Long = (-16) '// New window NewSize
 
'//////////////////////////////////////////////////////////////////
Private Declare PtrSafe Function GetForegroundWindow Lib "User32.dll" () As Long
 
Private Declare PtrSafe Function GetWindowLong _
  Lib "User32.dll" Alias "GetWindowLongA" _
    (ByVal hWnd As Long, _
     ByVal nIndex As Long) _
  As Long
 
Private Declare PtrSafe Function SetWindowLong _
  Lib "User32.dll" Alias "SetWindowLongA" _
    (ByVal hWnd As Long, _
     ByVal nIndex As Long, _
     ByVal dwNewLong As Long) _
  As Long
 
Private Const WS_THICKFRAME As Long = &H40000
Private Const GWL_STYLE As Long = -16
 
'-----------Window NewSize------------------------------------------------------------------
Private Const UF_MIN As Long = &H20000 '// Minimize button
Private Const UF_MAX As Long = &H10000 '// Maximize button
 
'----------Variable Module----------------------------------------------------------------
Dim UF_Resized As Long
Dim NewSize As Long
 
 
Public Sub FormResizable()
 
Dim lStyle As Long
Dim hWnd As Long
Dim RetVal
 
hWnd = GetForegroundWindow
 
lStyle = GetWindowLong(hWnd, GWL_STYLE) Or WS_THICKFRAME
RetVal = SetWindowLong(hWnd, GWL_STYLE, lStyle)
 
End Sub
 
Private Sub UserForm_Activate()
Call FormResizable 'l utilisateur peut rédimensionner la taille de l'userform à l'aide des flèches indicatives sur le bord du formulaire
End Sub
 
Private Sub UserForm_Initialize()
 
    Me.Width = Application.WindowState
    Me.Height = Application.WindowState
    Call X1cFormResize
    UF_Resized = FindWindowA(vbNullString, Me.Caption)
    NewSize = StartWindow(UF_Resized, CURRENT_SIZE)
    NewSize = NewSize Or UF_MIN '//Minimize button
    NewSize = NewSize Or UF_MAX '//Maximize button
    MoveWindow UF_Resized, CURRENT_SIZE, (NewSize)
 
End Sub
 
Private Sub X1cFormResize()
    Application.WindowState = xlMaximized
    If ActiveWindow.Width > Me.Width And ActiveWindow.Height > Me.Height Then Exit Sub
    If (Round((ActiveWindow.Width * 0.98) / Me.Width, 2) * 100) - 1 < _
       (Round((ActiveWindow.Height * 0.98) / Me.Height, 2) * 100) - 1 Then
        Me.Zoom = (Round((ActiveWindow.Width * 0.98) / Me.Width, 2) * 100) - 1
        Me.Width = Me.Width * Me.Zoom / 100
        Me.Height = Me.Height * Me.Zoom / 100
 
    Else
        Me.Zoom = (Round((ActiveWindow.Height * 0.98) / Me.Height, 2) * 100) - 1
        Me.Width = Me.Width * Me.Zoom / 100
        Me.Height = Me.Height * Me.Zoom / 100
 
    End If
End Sub
 
 
Sub TailleUserform()
Dim ctl As Control
Dim Larg As Integer
Dim Haut As Integer
 
Larg = Application.Width / Me.Width
Haut = Application.Height / Me.Height
'Me.Left = 0
'Me.Top = 0
'Me.Width = Application.WindowState
'Me.Height = Application.WindowState
For Each ctl In Me.Controls
  ctl.Left = ctl.Left * Larg
  ctl.Top = ctl.Top * Haut
  ctl.Width = ctl.Width * Larg
  ctl.Height = ctl.Height * Haut
'  ctl.Font.Size = ctl.Font.Size * Larg
Next
End Sub
 
Private Sub UserForm_Resize()
Call TailleUserform
End Sub

En conclusion, comment intercepter ce changement de taille?
merci de m'aider

**umfred** · 14/06/2023, 16h42

Application.WindowsState ne donne pas de dimension, mais indique l'état (réduit, maximisé, normal) de l'application (Excel) https://learn.microsoft.com/fr-fr/of...on.windowstate

Si c'est pour réagir au redimensionnement de la fenêtre du classeur, ça serait plutôt au niveau de l'événement Workbook_WindowResize(ByVal Wn As Window) dans l'objet ThisWorkbook (le classeur)
Et utiliser Application.UsableHeight et Application.UsableWidth pour les dimensions (voir l'exemple donné dans mon lien plus haut)

**Mr l'Ashanti** · 15/06/2023, 01h19

Envoyé par umfred

Application.WindowsState ne donne pas de dimension, mais indique l'état (réduit, maximisé, normal) de l'application (Excel) https://learn.microsoft.com/fr-fr/of...on.windowstate

Si c'est pour réagir au redimensionnement de la fenêtre du classeur, ça serait plutôt au niveau de l'événement Workbook_WindowResize(ByVal Wn As Window) dans l'objet ThisWorkbook (le classeur)
Et utiliser Application.UsableHeight et Application.UsableWidth pour les dimensions (voir l'exemple donné dans mon lien plus haut)

merci pour l'idée. j'ai pu enfin trouver la solution en interceptant le changement des dimensions grace à l'évènement Userform_Resize.

**umfred** · 15/06/2023, 13h30

Envoyé par Mr l'Ashanti

merci pour l'idée. j'ai pu enfin trouver la solution en interceptant le changement des dimensions grace à l'évènement Userform_Resize.

si c'est possible de la connaitre ?

**Mr l'Ashanti** · 16/06/2023, 20h32

Envoyé par umfred

si c'est possible de la connaitre ?

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
////////////////////////////////////////////////////////////////////
'recuperation des dimensions à l'initialisation
'a mettre dans l'userform initialize
TailleH = ActiveWindow.Height: TailleW = ActiveWindow.Width
TailleHUsf = Me.Height: TailleWUsf = Me.Width
 
End Sub
 
Private Sub UserForm_Resize()
 For Each Cl In Me.Controls
 
        If Gauche < 0 Then
            Cl.Height = Cl.Height / (TailleH / TailleHUsf)
            Cl.Width = Cl.Width / (TailleW / TailleWUsf)
            Cl.Top = Cl.Top / (TailleH / TailleHUsf)
            Cl.Left = Cl.Left / (TailleW / TailleWUsf)
        ElseIf Gauche = 0 And TextBox12 < 1036 Then
            Cl.Height = Cl.Height / (TailleH / TailleHUsf) * 0.9988
            Cl.Width = Cl.Width / (TailleW / TailleWUsf) * 0.9988
            Cl.Top = Cl.Top / (TailleH / TailleHUsf) * 0.9988
            Cl.Left = Cl.Left / (TailleW / TailleWUsf) * 0.9988
        ElseIf Gauche > 0 Then
            Cl.Height = Cl.Height * (TailleH / TailleHUsf)
            Cl.Width = Cl.Width * (TailleW / TailleWUsf)
            Cl.Top = Cl.Top * (TailleH / TailleHUsf)
            Cl.Left = Cl.Left * (TailleW / TailleWUsf)
        End If
    Next
    End Sub
Private Sub UserForm_Layout()
Gauche = Me.Left
TextBox12 = Me.Width
TextBox11 = Height - Me.Frame110.Top
 
If TextBox11 >= 571 Then
    For Each Cl In Me.Controls
        Cl.Height = Cl.Height * (TailleH / TailleHUsf)
        Cl.Width = Cl.Width * (TailleW / TailleWUsf)
        Cl.Top = Cl.Top * (TailleH / TailleHUsf)
        Cl.Left = Cl.Left * (TailleW / TailleWUsf)
    Next
    If TextBox11 >= 588 Then
       For Each Cl In Me.Controls
        Cl.Height = Cl.Height * (TailleH / TailleHUsf)
        Cl.Width = Cl.Width * (TailleW / TailleWUsf)
        Cl.Top = Cl.Top * (TailleH / TailleHUsf)
        Cl.Left = Cl.Left * (TailleW / TailleWUsf)
    Next
    End If
End If
End Sub

redimensionner la taille de l'userform après agrandissement ou réduction [XL-2019]

Macros et VBA Excel

Discussions similaires

Partager

Partager