Procédure pour plusieurs userform

Version imprimable

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:

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:

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

27/05/2015, 16h39
Daniel.C

Bonjour,

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

Bojour,

Code:

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

27/05/2015, 16h54
crookix

1 pièce(s) jointe(s)

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 :
27/05/2015, 17h06
crookix

1 pièce(s) jointe(s)

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 !!

Code:

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:

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:

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

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:

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