Discussion :

[patricktoulon]

bonjour a tous

depuis quelques jour je m'emploie a reduire mes codes

aujourdh'ui je suis sur mon effet mouse over sur les controls dans l'userform
le tout gérer par une classe

cela dit pour chaque type de control une classecontrol est instanciée

y a t il un moyen de regrouper les control qui ont le meme type d'evenement et de propriété
exemple les commandbutton,les labels ,les checkboxs,les optionButtons ont tous un evenements click et une caption ,un backcolor,font.color,forecolor

regrouper ces controls dans la memeinstance reduirait forcement les intances de la classecontrol

seulement dans la classecontrol il y a en haut de module

Code :

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

1
2
3
4
5
6
7
 
Public WithEvents GroupeBouton As MSForms.CommandButton
Public WithEvents Groupeusf As MSForms.UserForm
Public WithEvents Groupelabel As MSForms.Label
Public WithEvents Groupeopt As MSForms.OptionButton
Public WithEvents Groupecheckbox As MSForms.CheckBox
Public WithEvents GroupeImage As MSForms.Image

groupe..... representant chaque type de control

enfin bref je vous donne les codes en entier pour que vous puissiez juger
dans le userform on va mettre

Code :

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

1
2
3
4
 
 Private Sub UserForm_Activate()
    memo Me, , , True, True
End Sub

les arguments apres me sont facultatif vous pouvez simplement mettre "memo Me"

dans un module standard on vamettre ceci:
ce module va servir a mettre chaque control dans leur instances de la classecontrol
comme vous pouvez le constater des le depart on a chaque variable tableau representant un type de control instancier une classe (c'est ce qui me gene un peu je dois dire )

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
 
Option Explicit
Public bouton() As New classe_forme   'initialisation de la classe
Public usf() As New classe_forme
Public labelo() As New classe_forme
Public optbouton() As New classe_forme
Public checko() As New classe_forme
Public stImage() As New classe_forme
 
Dim a, e, i, d, s, c, z
Public ctrls As Object    'variable qui va servir a memoriser tout les bouton
Public maform As Object    'variable qui va servir a memoriser l'userform
Public oldbouton As String, oldlabel As String, oldcheckbox As String, oldoptionbouton As String
Public sfontbold As Boolean, sfontItalic As Boolean
Public coulover As Variant, coultextover As Variant
Sub memo(uf As Object, Optional backcouleur As Variant = vbRed, Optional couleurtext As Variant = vbWhite, Optional ftbold As Boolean = False, Optional ftitalic As Boolean = False)
    coulover = backcouleur
    coultextover = couleurtext
    sfontbold = ftbold
    sfontItalic = ftitalic
    Set maform = uf        'dorénavant maform designera l'userform dans tout le classeur
    Dim e As Long
    'on boucle sur tout les controls dans l'userform
    For Each ctrls In uf.Controls
 
        If TypeName(ctrls) = "CommandButton" Then
            'on memorise leur couleur de base dans leur propre tag au cas ou on voudrais avoir l'effet mouse over _
             appliquer dans la classe sur  le move des boutons dans cet exemplaire exemple
            ctrls.Tag = ctrls.BackColor & ":" & ctrls.ForeColor
            If ctrls.Font.Bold = True Then ctrls.Tag = ctrls.Tag & ":oui" Else: ctrls.Tag = ctrls.Tag & ":non"
            If ctrls.Font.Italic = True Then ctrls.Tag = ctrls.Tag & ":oui" Else: ctrls.Tag = ctrls.Tag & ":non"
            a = a + 1
            'on regroupe tout les bouton dans la classe
            ReDim Preserve bouton(1 To a)
            Set bouton(a).GroupeBouton = ctrls
        ElseIf TypeName(ctrls) = "Label" Then
            e = e + 1
            'on regroupe tout les label dans la classe
            ReDim Preserve labelo(1 To e)
            Set labelo(e).Groupelabel = ctrls
 
        ElseIf TypeName(ctrls) = "OptionButton" Then
            i = i + 1
            'on regroupe tout les OptionButton dans la classe
            ReDim Preserve optbouton(1 To i)
            Set optbouton(i).Groupeopt = ctrls
 
        ElseIf TypeName(ctrls) = "CheckBox" Then
            i = i + 1
            'on regroupe tout les CheckBox dans la classe
            ReDim Preserve checko(1 To i)
            Set checko(i).Groupecheckbox = ctrls
 
        ElseIf TypeName(ctrls) = "Image" Then
            d = d + 1
            'on regroupe tout les CheckBox dans la classe
            ReDim Preserve stImage(1 To d)
            Set stImage(d).GroupeImage = ctrls
        End If
    Next
    ReDim Preserve usf(1)
    Set usf(1).Groupeusf = uf
End Sub

maintenant la classecontrol

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
 
Public WithEvents GroupeBouton As MSForms.CommandButton
Public WithEvents Groupeusf As MSForms.UserForm
Public WithEvents Groupelabel As MSForms.Label
Public WithEvents Groupeopt As MSForms.OptionButton
Public WithEvents Groupecheckbox As MSForms.CheckBox
Public WithEvents GroupeImage As MSForms.Image
Dim truc As OLEObjects
'EVENEMENT MouseMove DE TOUS LES BOUTONS
Public Sub GroupeBouton_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If oldbouton <> "" Then remet_oldcontrol_normal
    If GroupeBouton.BackColor <> vbRed Then
        GroupeBouton.BackColor = coulover: GroupeBouton.ForeColor = coultextover: GroupeBouton.Font.Bold = sfontbold: GroupeBouton.Font.Italic = sfontItalic
        oldbouton = GroupeBouton.Name
    End If
End Sub
'EVENEMENT Mousemove DE L USERFORM
Private Sub Groupeusf_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
' si un bouton a été survolé oldbouton n'est plus vide alors
    If oldbouton <> "" Then remet_oldcontrol_normal
End Sub
'EVENEMENT Click DE TOUS LES LABELS
Private Sub Groupelabel_Click()
    MsgBox "coucou je suis un " & TypeName(Groupelabel) & vbCrLf & "mon nom est " & Groupelabel.Name
End Sub
'EVENEMENT Click DE TOUS LES OPTIONBOUTON
Private Sub Groupeopt_Click()
    MsgBox "coucou je suis un " & TypeName(Groupeopt) & vbCrLf & "mon nom est " & Groupeopt.Name
End Sub
'EVENEMENT Click DE TOUS LES CHECKBOXS
Private Sub Groupecheckbox_Click()
    MsgBox "coucou je suis un " & TypeName(Groupecheckbox) & vbCrLf & "mon nom est " & Groupecheckbox.Name
End Sub
'EVENEMENT Click DE TOUtes LES Images
Private Sub GroupeImage_Click()
    MsgBox "coucou je suis un " & TypeName(GroupeImage) & vbCrLf & "mon nom est " & GroupeImage.Name
End Sub
 
'REMET LE DERNIER BOUTON SURVOLE A SON ETAT INITIALen utilisant la variables "oldcontrol" qui contient le nom du dernier bouton survolé
Sub remet_oldcontrol_normal()
    maform.Controls(oldbouton).BackColor = Split(maform.Controls(oldbouton).Tag, ":")(0)
    maform.Controls(oldbouton).ForeColor = Split(maform.Controls(oldbouton).Tag, ":")(1)
    If Split(maform.Controls(oldbouton).Tag, ":")(2) = "non" Then maform.Controls(oldbouton).Font.Bold = False
    If Split(maform.Controls(oldbouton).Tag, ":")(3) = "non" Then maform.Controls(oldbouton).Font.Italic = False
End Sub

voila alors y a t il un moyen de reduire ce code

merci pour le retour au plaisir

[Montor]

Pourquoi ne regroupe toute les événement dans une seule class

[patricktoulon]

bonjour Montor

oui et comment?
sachant que dans la classe
en debut de code chaque type de control est integré par son typename
alors la question est y a t il une variable designant un ou plusieur de ces controls
a propos tu ne m' a pas donné de nouvelles au sujet de ton probleme avec cdo
au plaisir

[Montor]

Bonjour
Les interface n'ont pas le même ancêtre inutile de chercher dans ce coté a part d'accéder directement via IDipatch.invoke mais qui oblige l'activation d'un fichier tlb hack (si tu es curieux je te donne exemple )

comment faire ?

Réarrange ta classe recrée des événements click onmousemove ...

a propos tu ne m' a pas donné de nouvelles au sujet de ton problème avec cdo

Non j'ai abandonné ...

[patricktoulon]

bonjour montor

on va la laisser comme ca cette classe pour le moment

comment ca tu a abandoné a tu essayé mon code cdo sur un fichier vierge ???

au plaisir

[Montor]

ne te casse pas la tête je ne suis plus intéressé a ça