Stocker les propriétés d’un label (Userform) dans un module

Version imprimable

Bonjour à tous,
J’ai un Userform contenant des Label(s) avec une mise en forme qui se répète. Je vous mets un petit bout de code :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Private Sub UserForm_Initialize() 'bouton suivant1 UserForm1.Label4.ForeColor = RGB(70, 70, 70) 'couleur texte dark grey UserForm1.Label4.BackColor = RGB(211, 240, 224) 'couleur bouton green UserForm1.Label4.BorderColor = RGB(134, 191, 160) 'couleur contour dark green 'bouton suivant2 UserForm1.Label9.ForeColor = RGB(70, 70, 70) UserForm1.Label9.BackColor = RGB(211, 240, 224) UserForm1.Label9.BorderColor = RGB(134, 191, 160) 'bouton suivant3 UserForm1.Label15.ForeColor = RGB(70, 70, 70) UserForm1.Label15.BackColor = RGB(211, 240, 224) UserForm1.Label15.BorderColor = RGB(134, 191, 160) End Sub
Comme vous pouvez le constater c’est toujours la même mise en forme (seul le label change). Alors je me demandais si c’était possible de stocker les propriétés de cette mise en forme dans un module et l’appeler sans avoir à tout remarquer. J’ai tenté un truc mais ça ne marche pas du tout lol ! Si quelqu’un connait une technique je suis preneur 😊
Code:

1 2 3 4 5 Sub Couleur_Label (Texte As String) UserForm1.Texte.ForeColor = RGB(70, 70, 70) UserForm1.Texte.BackColor = RGB(211, 240, 224) UserForm1.Texte.BorderColor = RGB(134, 191, 160) End sub
Code:

Call Couleur_Label (Label4)

Citation:

Envoyé par Romain.Frc

Bonjour,

Dans un module de classe baptisé cLabel

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
Option Explicit
 
Public WithEvents mLabel As MSForms.Label
 
 
Sub MefLabels(LabelEnCours2 As MSForms.Label)
 
  Set mLabel = LabelEnCours2
 
  With mLabel
 
       .BorderStyle = fmBorderStyleSingle
       .ForeColor = RGB(70, 70, 70) 'couleur texte dark grey
       .BackColor = RGB(211, 240, 224) 'couleur bouton green
       .BorderColor = RGB(134, 191, 160)  'couleur contour dark green
 
 
  End With
 
End Sub

Dans votre userform :

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
 
Option Explicit
 
Dim Ctl As MSForms.Control
Dim CollectionLabels As Collection
 
 
 
Private Sub UserForm_Initialize()
 
Dim LabelEnCours As MSForms.Label
Dim cControl As CLabel
Set CollectionLabels = New Collection
 
   For Each Ctl In Me.Controls
 
      If TypeOf Ctl Is MSForms.Label Then
         Set cControl = New CLabel
         cControl.MefLabels Ctl
         CollectionLabels.Add cControl
      End If
 
   Next
 
End Sub

Pièce jointe 584112

Pour en savoir plus sur les modules de classe, voir les tutos de P FAUCONNIER et d'Emmanuel TISSOT :

16/11/2020, 18h25
Romain.Frc

1 pièce(s) jointe(s)

Bonjour Eric et merci pour votre contribution,

J'ai appliqué la méthode, la mise en forme se fait bien sur tous mes boutons suivants. Mais le souci c'est que tous les autres labels (nom, prénom etc...) se retrouvent aussi modifiés ^^
Pièce jointe 584120

Bonjour le Fil

On peut aussi ajouter une méthode dans l'userform :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Option Explicit
Private Sub UserForm_Initialize()
  'bouton suivant1
  Me.InitLabel Me.Label4
  'bouton suivant2
  Me.InitLabel Me.Label9
  'bouton suivant3
  Me.InitLabel Me.Label15
End Sub
Sub InitLabel(lbl As msforms.Label)
  lbl.ForeColor = RGB(70, 70, 70)
  lbl.BackColor = RGB(211, 240, 224)
  lbl.BorderColor = RGB(134, 191, 160)
End Sub

16/11/2020, 18h35
Romain.Frc

Bonjour Patrice,

Cette méthode fonctionne parfaitement, merci beaucoup !!

problème résolu :D

Citation:

Envoyé par Romain.Frc

Au cas où, il suffit de mettre une valeur dans la propriété tag des labels que vous souhaitez distinguer.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 
 
Private Sub UserForm_Initialize()
 
Dim LabelEnCours As MSForms.Label
Dim cControl As CLabel
Set CollectionLabels = New Collection
 
   For Each Ctl In Me.Controls
 
      If TypeOf Ctl Is MSForms.Label And Ctl.Tag = "A" Then
         Set cControl = New CLabel
         cControl.MefLabels Ctl
         CollectionLabels.Add cControl
      End If
 
   Next
 
End Sub

17/11/2020, 07h52
Romain.Frc

Effectivement cette méthode marche également, un grand merci à vous deux !