Gestion des UserForm multipages

**Vba14** · 06/04/2019, 21h39

Bonsoir à tous,

Je vais mettre en place un UserForm avec multi pages.

J'aimerai savoir comment :
- faire pour gérer les dimensions de l'UF et des multipages.
- est-il possible de mettre de la couleur dans les multipages
- comment rendre visible ou pas une page selon le choix fait par l'utilisateur
- est-ce qu'un bouton "Validation" placé sur l'UF peut-être utilisé pour toutes les pages.

Merci par avance pour vos réponses.

**Vba14** · 06/04/2019, 22h47

J'ai trouvé les solutions à mes problèmes
Bonne nuit à tout le monde

**patricktoulon** · 07/04/2019, 00h26

Envoyé par Vba14

Bonsoir à tous,

Je vais mettre en place un UserForm avec multi pages.

J'aimerai savoir comment :
- faire pour gérer les dimensions de l'UF et des multipages.
- est-il possible de mettre de la couleur dans les multipages
- comment rendre visible ou pas une page selon le choix fait par l'utilisateur
- est-ce qu'un bouton "Validation" placé sur l'UF peut-être utilisé pour toutes les pages.

Merci par avance pour vos réponses.

bonsoir vba14

1°- faire pour gérer les dimensions de l'UF et des multipages.---> oui de la même manière que les autre controls width height

2°- est-il possible de mettre de la couleur dans les multipages --> normalement non !! mais tu peux utiliser une astuce dynamiquement ou pas
a savoir mettre un controls image en arriere plan a la quelle tu applique une couleur

3°- comment rendre visible ou pas une page selon le choix fait par l'utilisateur --> la encore la réponse est la meme de la même manière que les autre controls
a savoir ex: multipage1.pages(3).visible=false(la 4 eme page sera invisible)

4°- est-ce qu'un bouton "Validation" placé sur l'UF peut-être utilisé pour toutes les pages.--> la réponse est oui bien entendu

je reviens sur la couleur pour le multipage

voici une petite fonction qui te met tes page en couleur (toutes/en fonction de l'array)

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
 
Private Sub UserForm_Activate()
'backcolorM MultiPage1, Array(0, 3, 5), vbRed'certaines pages en rouge
'ou
'
    'backcolorM MultiPage1, Array(0, 3, 5), Array(146325, 1723654, 119546)    'certaines pages couleurs différentes
'ou
'
'backcolorM MultiPage1, 0, vbRed    ' tout les pages en rouge
'ou
' tout les pages une couleur différente
backcolorM MultiPage1, 0, Array(vbBlue, vbGreen, vbRed, vbCyan, vbMagenta, RGB(123, 187, 45), 134521)
End Sub
'
Private Function backcolorM(obj, Opages As Variant, coul As Variant) As String
    Dim x&, i&, img
    If Not IsArray(Opages) Then
        Opages = Application.Transpose(Evaluate("ROW(1:" & MultiPage1.pages.Count & ")"))
        x = 1
    End If
    For i = LBound(Opages) To UBound(Opages)
        Set img = obj.pages(Opages(i) - x).Controls.Add("forms.Image.1", "fond")
        With img: .Top = 0: .Left = 0: .Width = obj.Width: .Height = obj.Height: .ZOrder 1:
            If IsArray(coul) Then
                .BackColor = coul(i - x)
            Else
                .BackColor = coul
            End If
        End With
    Next
End Function

**Vba14** · 07/04/2019, 08h21

Bonjour Patrick,

Merci beaucoup pour tes réponses. J'en avais déjà trouvé sur le forum, mais tu viens les conforter. Par contre, concernant les couleurs ça c'est top.
Avec tout ça je vais pouvoir m'en sortir.
Mon projet avance bien, à part bien entendu le soucis de mot de passe, mais ça c'est une autre discussion. Je continue.
Si on ne se reparle pas, je te souhaite un agréable Dimanche. Ici en Normandie il va être plutôt gris et pluvieux
Amicalement
René

**Vba14** · 07/04/2019, 10h49

Re,

Voilà j'ai mis en place ce code qui me permet de redimensionner mon MultiPages. Cependant, j'aurai voulu y ajouter le fait que l'UserForm (UFSaisie) ait une taille différente de celle des pages.
Il faut que l'UF soit un peu plus grand. Pour le moment UF suit la dimension des pages...

Dans l'absolu, se serait que l'UF s'adapte à la taille de la page de façon dynamique.

Merci par avance pour votre aide

Voici mon 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
 
Private Sub MultiPage1_Change()
   With Me
        Select Case .MultiPage1.Value
            Case 0 'Correspond à la page 1
                .Height = 339
                .Width = 265       
 
            Case 1 'Correspond à la page 2
                .Height = 402
                .Width = 439
 
            Case 2 'Correspond à la page 3
                .Height = 513
                .Width = 344
 
            Case 3 'Correspond à la page 4
                .Height = 400
                .Width = 438
 
            Case 4 'Correspond à la page 5
                .Width = 349
                .Height = 404
 
            Case 5 'Correspond à la page 6
                .Width = 537
                .Height = 343
 
        End Select
        .Repaint
    End With
End Sub

Quelque chose comme ça peut-être :

Code :

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

1
2
3
4
5
6
 
 
Private Sub UserForm_Activate()
UserForm1.Caption = "Vous allez saisir un Article" 'Le caption changera selaon la feuille affichée
Tag = Height ' Enregistre la hauteur initiale. ' C'est là où je ne sais pas faire, comment lui donner ses dimensions par rapport à la page
End Sub

**Vba14** · 07/04/2019, 12h00

Patrick,

J'ai lu ta participation sur le redimensionnement automatique des UserForm, c'est super, mais il ne peut pas s'appliquer à redimensionnement par rapport aux pages, c'est uniquement par rapport à l'écran.
N'est-ce-pas?

Merci beaucoup pour ce modèle, je l'ai conservé dans mes archives, cela pourra me servir.

**patricktoulon** · 07/04/2019, 14h08

bonjour
pour le redim....
ben si justement tu adapte

si je comprends bien tu redim le multi mais pas le userform c'est ca ??

**Vba14** · 07/04/2019, 14h25

Re,

Oui c'est ça, c'est même indispensable puisque des boutons vont se trouver sur l'UF mais pas dans les pages, car comme je l'ai dis plus haut, les boutons seront communs à toutes les pages.

**patricktoulon** · 07/04/2019, 14h36

re
un truc dans ce genre la
Nom : demo3.gif
Affichages : 2317
Taille : 212,6 Ko

**Vba14** · 07/04/2019, 14h46

Tout à fait. Sauf que les boutons seront placés sur l'UF pas dans les pages, mais tu as très bien saisi mon idée

Voici mon code modifié, puisque je cache les autres feuilles quand une est activée.

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
 
Private Sub MultiPage1_Change()
   With Me
        Select Case .MultiPage1.Value
            Case 0 'Correspond à la page 1
                .Height = 339
                .Width = 265
                MultiPage1.Pages(1).Visible = False
                MultiPage1.Pages(2).Visible = False
                MultiPage1.Pages(3).Visible = False
                MultiPage1.Pages(4).Visible = False
                MultiPage1.Pages(5).Visible = False
 
 
            Case 1 'Correspond à la page 2
                .Height = 402
                .Width = 439
                MultiPage1.Pages(0).Visible = False
                MultiPage1.Pages(2).Visible = False
                MultiPage1.Pages(3).Visible = False
                MultiPage1.Pages(4).Visible = False
                MultiPage1.Pages(5).Visible = False
 
 
            Case 2 'Correspond à la page 3
                .Height = 513
                .Width = 344
                MultiPage1.Pages(0).Visible = False
                MultiPage1.Pages(1).Visible = False
                MultiPage1.Pages(3).Visible = False
                MultiPage1.Pages(4).Visible = False
                MultiPage1.Pages(5).Visible = False
 
 
            Case 3 'Correspond à la page 4
                .Height = 400
                .Width = 438
                MultiPage1.Pages(0).Visible = False
                MultiPage1.Pages(1).Visible = False
                MultiPage1.Pages(2).Visible = False
                MultiPage1.Pages(4).Visible = False
                MultiPage1.Pages(5).Visible = False
 
 
            Case 4 'Correspond à la page 5
                .Width = 349
                .Height = 404
                MultiPage1.Pages(0).Visible = False
                MultiPage1.Pages(1).Visible = False
                MultiPage1.Pages(2).Visible = False
                MultiPage1.Pages(3).Visible = False
                MultiPage1.Pages(5).Visible = False
 
 
            Case 5 'Correspond à la page 6
                .Width = 537
                .Height = 343
                MultiPage1.Pages(0).Visible = False
                MultiPage1.Pages(1).Visible = False
                MultiPage1.Pages(2).Visible = False
                MultiPage1.Pages(3).Visible = False
                MultiPage1.Pages(4).Visible = False
 
 
        End Select
        .Repaint
    End With
End Sub

**patricktoulon** · 07/04/2019, 15h05

re
oui c'est ca que tu veux regarde les bouton de couleurs
Nom : demo3.gif
Affichages : 2349
Taille : 338,9 Ko

exemple comme ca a l'arrache a 3 coup de clavier un principe

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
Dim min_width
Dim heightCaption
Dim weight_cadre
Dim heightbuttonnomulti
Dim leftbutton1
Dim leftbutton2
Private Sub MultiPage1_Change()
 
    w = 0: h = 0
    With Me.MultiPage1
        For Each ctrl In .Pages(.Value).Controls
            If ctrl.Left + ctrl.Width > w Then w = ctrl.Left + ctrl.Width
            If ctrl.Top + ctrl.Height > h Then h = ctrl.Top + ctrl.Height
        Next
        .Width = IIf(w > min_width, w, min_width) + 10
        .Height = h + 10 + weight_cadre + heightCaption
        Me.Width = IIf(w > min_width, w, min_width) + 20 + weight_cadre * 2: Me.Height = h + 20 + heightCaption * 2 + heightbuttonnomulti
    End With
    bouton1.Left = Me.InsideWidth - leftbutton1 - 10
    bouton1.Top = Me.Height - 40
    bouton2.Left = Me.InsideWidth - leftbutton2 - 10
    bouton2.Top = Me.Height - 40
End Sub
Private Sub UserForm_Activate()
    min_width = MultiPage1.Pages.Count * 35
    heightCaption = (Me.Height - Me.InsideHeight)
    weight_cadre = (Me.Width - Me.InsideWidth)
    Me.Width = min_width
    heightbuttonnomulti = bouton1.Height + 10
    leftbutton1 = Me.InsideWidth - bouton1.Left
    leftbutton2 = Me.InsideWidth - bouton2.Left
End Sub

**Vba14** · 07/04/2019, 15h25

En plein dans le mille, c'est exactement ça.
Je vais copier ton code, avec ta permission, et l’adapter à mes besoins. C'est vraiment super

J'ai 6 pages dans mon Multipages, cela ne doit pas causer de problème !!!

Donc dans ton exemple, plus besoin de noter les Height et Width dans le code, tout se fait automatiquement ?

**patricktoulon** · 07/04/2019, 15h53

re
oulah !! ne t'emballe pas
comme je t'ai dis je t'ai codé ca en une minute30 hein c'est sale, brouillon, peut être même foireux
je t'ai juste montré le principe hein

allez voila quelque chose de BEAUCOUP plus propre

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
Private Type p
    width As Long
    height As Long
    leftbutton1 As Long
    leftbutton2 As Long
    hcaption As Long
End Type
Dim Mpage() As p
'
Private Sub MultiPage1_Change()
    With MultiPage1
        .width = WorksheetFunction.Min(500, Mpage(.Value).width)
        .height = Mpage(.Value).height
        bouton1.Left = Mpage(.Value).leftbutton1: bouton1.Top = .height + 5
        bouton2.Left = Mpage(.Value).leftbutton2: bouton2.Top = .height + 5
        Me.height = .height + Mpage(.Value).hcaption + bouton1.height + 15
        Me.width = .width + Mpage(.Value).hcaption
    End With
End Sub
'
Private Sub UserForm_Activate()
Dim WW, HH
    For Each pag In MultiPage1.Pages
        ReDim Preserve Mpage(0 To pag.Index)
        WW = 0: HH = 0
        For Each ctrl In pag.Controls
            If ctrl.Left + ctrl.width + 20 > WW Then WW = ctrl.Left + ctrl.width + 20: If WW < 200 Then WW = 200
            If ctrl.Top + ctrl.height + 25 > HH Then HH = ctrl.Top + ctrl.height + 25
        Next
        Mpage(pag.Index).width = WW: Mpage(pag.Index).height = HH
        Mpage(pag.Index).leftbutton1 = WW - bouton1.width * 2.3
        Mpage(pag.Index).leftbutton2 = WW - bouton2.width * 1.15
        Mpage(pag.Index).hcaption = Me.height - Me.InsideHeight
    Next
End Sub

tellement plus facile avec des variable typé pour générer un tableau de properties ou de détails d'un élément hein

je te donne le fichier pour que tu t'exerce dessus avant de bousiller ton travail

tu verra c'est plus net

ET OUI TOUT SE FAIT AUTOMATIQUEMENT

il y a un seul truc qui me gene et que je n'ai pas encore trouvé de solution c'est le " 200" que tu vois dans le code
200 c'est le width qu'elle ferait si on la réduit a voir juste les onglets
c'est cette dimension en fonction du texte de la caption des pages que j'aimerais bien calculer automatiquement aussi
j'ai bien une idée avec un label autosize mais je cherche voir si je trouve pas mieux

**Vba14** · 07/04/2019, 18h27

Merci beaucoup Patrick, encore une fois tu m'es d'un grand secours.

Je vais m'exercer sur ton fichier, j'ai pris cette habitude de faire des essais auparavant sur un fichier lambda, comme ça même si je me plante, pas de dégâts sur l'original.

Toutes mes excuses pour avoir tardé à te répondre mais j'ai dû laisser l'ordi un peu de temps pour m'occuper de la famille.

Je regarde tout ça et je te dis ce qu'il en est.

**Vba14** · 07/04/2019, 18h36

Voici ton fichier avec mon UF, ça fonctionne plutôt bien, quelques réglages

à faire mais ce n'est pas mal du tout

resize exemple multi vba14-1.xlsm

**Vba14** · 07/04/2019, 19h58

Après plusieurs essais, ça me semble très très bien. J'ai fait les ajustements nécessaires à la position des boutons et je suis plus que satisfait.

Mille mercis Patrick, je vais pouvoir continuer sur les autres parties. La validation par clic sur le bouton et que les données aillent au bon endroit, dans la bonne feuille de calcul.

Si l'utilisateur choisi de saisir un Client par exemple, seul la page du Multipages concerné sera visible.

Je vais manger pour le moment, à plus tard et encore tout mes remerciements chaleureux

**patricktoulon** · 07/04/2019, 20h10

re
toute a l'heure j'ai regardé un peu on a pas la possibilités de changer le font size dans les onglet alors j'ai regardé on est en size d'origine "8"

et si j'enlève 1 et que je multiplie par le len de toute les captions réunies j'obtiens un minwidth plus que raisonnable
du coup la seule dimension qui était en dur dans le code envolée

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
 
Private Type p
    width As Long
    height As Long
    leftbutton1 As Long
    leftbutton2 As Long
    hcaption As Long
    Weight_Cadre As Long
End Type
Dim Mpage() As p
 
Private Function resizeMulti()
    With MultiPage1
        .width = Mpage(.Value).width
        .height = Mpage(.Value).height
        bouton1.Left = Mpage(.Value).leftbutton1: bouton1.Top = .height + Mpage(.Value).Weight_Cadre
        bouton2.Left = Mpage(.Value).leftbutton2: bouton2.Top = .height + Mpage(.Value).Weight_Cadre
        Me.height = .height + Mpage(.Value).hcaption + bouton1.height + Mpage(.Value).Weight_Cadre * 2
        Me.width = .width + Mpage(.Value).hcaption
    End With
End Function
 
Private Sub MultiPage1_Change(): resizeMulti: End Sub
Private Sub UserForm_Activate()
    Dim WW&, HH&, lC$, minlarge&, ctrl As Object
    For Each pag In MultiPage1.Pages: lC = lC & CStr(pag.Caption): Next: minlarge = Len(lC) * 7'!!!!!!!!!!!!!!!!!!!!!
    For Each pag In MultiPage1.Pages
        ReDim Preserve Mpage(0 To pag.Index)
        WW = 0: HH = 0
        For Each ctrl In pag.Controls
            If ctrl.Left + ctrl.width + 20 > WW Then WW = ctrl.Left + ctrl.width + 20: If WW < minlarge Then WW = minlarge
            If ctrl.Top + ctrl.height + 25 > HH Then HH = ctrl.Top + ctrl.height + 25
        Next
        Mpage(pag.Index).width = WW: Mpage(pag.Index).height = HH
        Mpage(pag.Index).leftbutton1 = WW - bouton1.width * 2.3
        Mpage(pag.Index).leftbutton2 = WW - bouton2.width * 1.15
        Mpage(pag.Index).hcaption = Me.height - Me.InsideHeight
        Mpage(pag.Index).Weight_Cadre = Me.width - Me.InsideWidth
    Next
    resizeMulti
End Sub

**Vba14** · 07/04/2019, 20h35

Je viens de tester ton code, pas de soucis pour ce qui est des hauteurs, par contre la largeur ne bouge pas.

**patricktoulon** · 07/04/2019, 21h31

re
re ben en fait rien ne depasse la largeur de tout les onglets réuni dans ton fichier c'est pour ca que le calcul change rien car le minimum large c'est tout les onglet

fait comme moi bloque la fin de cette ligne en fait tu ne veux pas de minimum imposé toi

Code :

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

If ctrl.Left + ctrl.width + 20 > WW Then WW = ctrl.Left + ctrl.width + 20: 'If WW < minlarge Then WW = minlarge

au final pour toi 'est plus simple j'enlevé encore 3lignes de 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
Private Type p
    width As Long
    height As Long
    leftbutton1 As Long
    leftbutton2 As Long
    hcaption As Long
    Weight_Cadre As Long
End Type
Dim Mpage() As p
Private Function resizeMulti()
    With MultiPage1
        .width = Mpage(.Value).width
        .height = Mpage(.Value).height
        bouton1.Left = Mpage(.Value).leftbutton1: bouton1.Top = .height + Mpage(.Value).Weight_Cadre
        bouton2.Left = Mpage(.Value).leftbutton2: bouton2.Top = .height + Mpage(.Value).Weight_Cadre
        Me.height = .height + bouton1.height + Mpage(.Value).hcaption + Mpage(.Value).Weight_Cadre * 2
        Me.width = .width + Mpage(.Value).hcaption
    End With
End Function
Private Sub MultiPage1_Change(): resizeMulti: End Sub
Private Sub UserForm_Activate()
    Dim WW&, HH&, lC$, minlarge&, ctrl As Object
    For Each pag In MultiPage1.Pages
        ReDim Preserve Mpage(0 To pag.Index)
        WW = 0: HH = 0
        For Each ctrl In pag.Controls
            If ctrl.Left + ctrl.width + 20 > WW Then WW = ctrl.Left + ctrl.width + 20:
            If ctrl.Top + ctrl.height + 25 > HH Then HH = ctrl.Top + ctrl.height + 25
        Next
        Mpage(pag.Index).width = WW: Mpage(pag.Index).height = HH
        Mpage(pag.Index).leftbutton1 = WW - bouton1.width * 2.3
        Mpage(pag.Index).leftbutton2 = WW - bouton2.width * 1.15
        Mpage(pag.Index).hcaption = Me.height - Me.InsideHeight
        Mpage(pag.Index).Weight_Cadre = Me.width - Me.InsideWidth
 
    Next
    resizeMulti
End Sub