Procédure pour plusieurs userform

**crookix** · 27/05/2015, 16h25

Bonjour à tous,

Je crée actuellement un tableau de bord munit d'un userform qui fait office de page d'acceuil, et qui par le biais de boutons ouvre différents userform (7 au total).

Afin d'adapter l'outil aux différents utilisateurs, j'ai codé de telle sorte que l'userform principal s'adapte à la résolution de l'écran et que sa taille soit modifiable par action de la souris (comme une fenêtre classique).

Je voudrais faire de même pour les autres userform du programme, mais je ne voudrais pas avoir à copier coller 7 fois le code (imaginez la lourdeur).

Est-il possible de créer les procédures avec comme paramètre le userform ?

Un exemple concret :

Dans un module standard :

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
Public largeurbouton(), hauteurbouton(), leftbouton(), topbouton() As String
Public w As Integer
Public ctrl As Control
Public largeure_usf, hauteure_usf As Long
Sub determine()
 
hauteure_usf = UserForm1.Height
largeure_usf = UserForm1.Width
w = 0
For Each ctrl In UserForm1.Controls
 w = w + 1
    ReDim Preserve largeurbouton(w)
    largeurbouton(w) = ctrl.Width
ReDim Preserve hauteurbouton(w)
    hauteurbouton(w) = ctrl.Height
ReDim Preserve topbouton(w)
    topbouton(w) = ctrl.Top
ReDim Preserve leftbouton(w)
    leftbouton(w) = ctrl.Left
Next
 
End Sub

Puis dans le module de l'userform :

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
Private Sub UserForm_Initialize()
    Ouverture = True
    Usf_Visible = True
    Nom_Classeur = ThisWorkbook.Name
 
determine   'appele la procedure qui va memoriser la taille et position de chaque controls
hwnd = FindWindow(vbNullString, Me.Caption)
wLong = GetWindowLongA(hwnd, GWL_STYLE) Or WS_SIZEBOX Or WS_TROIS_BOUTON  'si apostrophe devand il n'y a plus de bouton juste un cadre mince
SetWindowLong hwnd, GWL_STYLE, wLong 'applique le style a l'userform
With UserForm1
       .StartUpPosition = 3
       .Width = Application.Width - 2
      .Height = Application.Height - 3
  End With
 
 
End Sub

Je voudrais pouvoir écrire
Call determine (userform)

Merci d'avance pour votre réponse

**Daniel.C** · 27/05/2015, 16h39

Bonjour,

Tu ne peux pas mettre les valeurs obtenues dans des variables publiques ?

Invité · 27/05/2015, 16h41

Bojour,

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
Sub determine(UsF)
ReDim  largeurbouton(0)
ReDim  hauteurbouton(0)
ReDim  topbouton(0)
ReDim  leftbouton(0)
 
hauteure_usf = UsF.Height
largeure_usf = UsF.Width
w = 0
For Each ctrl In UsF.Controls
w = w + 1
ReDim Preserve largeurbouton(w)
largeurbouton(w) = ctrl.Width
ReDim Preserve hauteurbouton(w)
hauteurbouton(w) = ctrl.Height
ReDim Preserve topbouton(w)
topbouton(w) = ctrl.Top
ReDim Preserve leftbouton(w)
leftbouton(w) = ctrl.Left
Next
 
End Sub

**crookix** · 27/05/2015, 16h54

Bonjour à tous les deux et merci de vos réponse,

J'ai testé ta solution rdurupt mais j’obtiens une erreur 428 " Propriété ou méthode non gérée par cette objet"

Et j'ai essayé Daniel mais le problème est que je n'arrive pas à appeler ma fonction en lui mettant en paramètre l'userform.

Merci d'avance !

Je vous met un exemple qui illustre ce que je veux faire :

**crookix** · 27/05/2015, 17h06

Je n'ai rien dit ça fonctionne !

Je met le fichiers en pièce jointe, si ça peut en aider certains ! Reste a voir si je peux déclarer mes API en public mais c'est une autre histoire !

Merci !!

Invité · 27/05/2015, 17h15

Code Module1 :

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
 
 
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function GetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Dim wLong As Long
Const GWL_STYLE = (-16)
Const GWL_EXSTYLE = (-20)
Const WS_SIZEBOX = &H40000 'DONNE LA POSSIBILITe DE REDUIRE OU AGRANDIR MANUELLEMENT AVEC LA SOURIS
Const WS_TROIS_BOUTON = &H70000 'ajoute les deux bouton manquant dans le cadre de l'userform(minimizer et agrandire)
Const WS_EX_APPWINDOW = &H40000
 
Public largeurbouton(), hauteurbouton(), leftbouton(), topbouton() As String
Public w As Integer
Public ctrl As Control
Public largeure_usf, hauteure_usf As Long
Sub determine(Usf)
ReDim largeurbouton(0)
ReDim hauteurbouton(0)
ReDim topbouton(0)
ReDim leftbouton(0)
 
hauteure_usf = Usf.Height
largeure_usf = Usf.Width
w = 0
For Each ctrl In Usf.Controls
w = w + 1
ReDim Preserve largeurbouton(w)
largeurbouton(w) = ctrl.Width
ReDim Preserve hauteurbouton(w)
hauteurbouton(w) = ctrl.Height
ReDim Preserve topbouton(w)
topbouton(w) = ctrl.Top
ReDim Preserve leftbouton(w)
leftbouton(w) = ctrl.Left
Next
 
End Sub
Public Sub Usf_Resize(Usf)
On Error Resume Next
i = 0
For Each ctrl In Usf.Controls
i = i + 1
'largeure du control=largeure usf actuelle divisée par entre parenthezes  largeur usf de depart divisée par largeur de depart du control
ctrl.Width = Usf.Width / (largeure_usf / largeurbouton(i))
'hauteur du control = hauteur usf actuelle divisée par entre parenthezes  hauteur usf de depart divisée par hauteur de depart du control
ctrl.Height = Usf.Height / (hauteure_usf / hauteurbouton(i))
'le left du control = largeur usf actuelle divisée par entre parenthezes  largeur usf de depart divisée par le left de depart du control
ctrl.Left = Usf.Width / (largeure_usf / leftbouton(i))
'le top du control = hauteur usf actuelle divisée par entre parenthezes  hauteur usf de depart divisée par le top de depart du control
ctrl.Top = Usf.Height / (hauteure_usf / topbouton(i))
'le top du control = hauteur usf actuelle divisée par entre parenthezes  hauteur usf de depart divisée par le top de depart du control
ctrl.FontSize = ((Usf.Height + Usf.Width) / 8) / (fontbouton * 2)
Next
 
'Usf.Repaint 'repeint le userform pour effacer les traces des anciens emplacement des control(du a la puissance de la carte graphique)
End Sub

Code UserForm1 :

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
Private Sub CommandButton2_Click()
UserForm2.Show
End Sub
 
Private Sub UserForm_Initialize()
    Ouverture = True
    Usf_Visible = True
    Nom_Classeur = ThisWorkbook.Name
 
determine Me  'appele la procedure qui va memoriser la taille et position de chaque controls
hwnd = FindWindow(vbNullString, Me.Caption)
wLong = GetWindowLongA(hwnd, GWL_STYLE) Or WS_SIZEBOX Or WS_TROIS_BOUTON  'si apostrophe devand il n'y a plus de bouton juste un cadre mince
SetWindowLong hwnd, GWL_STYLE, wLong 'applique le style a l'userform
With Me
       .StartUpPosition = 3
       .Width = Application.Width - 2
      .Height = Application.Height - 3
  End With
 
 
End Sub
Private Sub UserForm_Resize()
Usf_Resize Me
'Me.Repaint 'repeint le userform pour effacer les traces des anciens emplacement des control(du a la puissance de la carte graphique)
End Sub

Code UserForm2 :

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
 
Private Sub UserForm_Initialize()
    Ouverture = True
    Usf_Visible = True
    Nom_Classeur = ThisWorkbook.Name
 
determine Me  'appele la procedure qui va memoriser la taille et position de chaque controls
hwnd = FindWindow(vbNullString, Me.Caption)
wLong = GetWindowLongA(hwnd, GWL_STYLE) Or WS_SIZEBOX Or WS_TROIS_BOUTON  'si apostrophe devand il n'y a plus de bouton juste un cadre mince
SetWindowLong hwnd, GWL_STYLE, wLong 'applique le style a l'userform
With Me
       .StartUpPosition = 3
       .Width = Application.Width - 2
      .Height = Application.Height - 3
  End With
 
 
End Sub
Private Sub UserForm_Resize()
Usf_Resize Me
End Sub

**crookix** · 27/05/2015, 17h17

Merci beaucoup ! c'est exactement ce qu'il me fallait ! Bonne fin de journée !

Petite précision, il faut mettre dans chaque module userform les lignes :

Code :

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

1
2
3
4
5
6
Dim wLong As Long
Const GWL_STYLE = (-16)
Const GWL_EXSTYLE = (-20)
Const WS_SIZEBOX = &H40000 'DONNE LA POSSIBILITe DE REDUIRE OU AGRANDIR MANUELLEMENT AVEC LA SOURIS
Const WS_TROIS_BOUTON = &H70000 'ajoute les deux bouton manquant dans le cadre de l'userform(minimizer et agrandire)
Const WS_EX_APPWINDOW = &H40000

Pour avoir les différents boutons et les possibilités d'agrandir

Procédure pour plusieurs userform

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager