Bouton- Frame - Couleur

Bonjour,

J'ai juste fait un léger changement dans le userform, chaque class a sa propre boucle,

L'ouverture du userform est plus rapide, et il n'y pas pas de sintiellement.

Merci ennormement a vous deux,

J'ai intégré ce code dans un fichier perso où il y a plusieurs frame, ça fonctionne merveilleusement bien

Bonsoir,

ravis que cela vous convienne ! Merci de votre retour et remerciement !

@ bientôt

LouReeD

Bonjour

je viens de faire la meme chose pour un multipage et un tabstrip, pour celui qui veut l’intégrer a so application

pas de scintillement, et ca fonctionne bien

Merci a vous 2 @LouReeD @saboh12617

Bonjour,

Comme @LooReed je suis content que vous ayez pu avancer ! Bonne journée et au plaisir.

Bonsoir,

en "mutualisant" le code de la boucle des couleurs vous gagnerez en ligne de code. Ensuite il est inutile sur votre fichier de garder la référence "LRD" du Frame !

@ bientôt

LouReeD

bonjour @LouReed

j'ai bien aimé gardé une trace ("LRD") ---->LouReed

aussi concernant la ligne de code, et la mutualisation, (merci pour le conseil) j'ai préféré les séparer je pense que pour moi c'est plus visible, et....je crois... qu"on ne perd pas trop de temps dans l’événement.

merci pour tous ce que tu fait dans ce forum

Bonjour,

En ligne de code oui, en temps pas vraiment, mais en simplification oui : si un jour cette boucle venait à être modifiée = un seul code à modifier...

Mais après " Chacun fait fait fait, c'qui lui plaît plaît plaît... "

@ bientôt

LouReeD

Sachant que je suis un bon élève, j'ai corrigé mon fichier

merci beaucoup @LouReed

bonjour

j'ai oublié la geqtion d'erreurs, au cas ou il n'y ai pas de multipage, de frame ou de bouton

On Error Resume Next 'Ignore les erreurs

voici e fichier, c'est au cas ou votre projet ne comporte pas de multipage ou de frame

merci

Bonjour,

pourquoi ne pas utiliser le principe de vos IF ElseIf pour le comptage de chaque type de contrôles :

    ' l'avantage on boucle une seule fois sur tous les contrôles
    For Each ctrl In UserForm1.Controls
        Select Case TypeName(ctrl)
            Case "Frame"
                CptFram = CptFram + 1
            Case "MultiPage"
                CptMultiPage = CptMultiPage + 1
            Case "TabStrip"
                CptTabStrip = CptTabStrip + 1
        End Select
    Next

Comme cela vous ne boucler qu'une fois sur les contrôles.

En y insérant les ReDim de chaque tableau de Classe, une seule boucle suffirait, non ?

@ bientôt

LouReeD

Je pensais à un truc comme cela mais ça n'a pas l'air de fonctionner :

    ' l'avantage on boucle une seule fois sur tous les contrôles
    For Each ctrl In UserForm1.Controls
        Select Case TypeName(ctrl)
            Case "Frame"
                CptFram = CptFram + 1
                ReDim Preserve FrameEvt(1 To CptFram)
                Set FrameEvt(CptFram) = New FrameEvent
                Set FrameEvt(CptFram).FrameLRD = ctrl
            Case "MultiPage"
                CptMultiPage = CptMultiPage + 1
            Case "TabStrip"
                CptTabStrip = CptTabStrip + 1
        End Select
    Next

Le ReDim Preserve n'a pas l'air de marcher... et pourtant pas d'erreur détectée...

Les Classes ne supportent elles pas les ReDim ?

@ bientôt

LouReeD

Bonjour @LouReeD

merci pour la reprise du post, et de l'ammelioration du code, ( je pense qu'il pourrais etre utile a certains )

comme cela ca (ci-joint le code )fonctionne bien , qu'en pense tu ?

Private Sub UserForm_Initialize()
    Dim ctrl As Control
    Dim i As Integer
    Dim CptFram As Integer
    Dim CptMultiPage As Integer
    Dim CptTabStrip As Integer

    On Error Resume Next 'Ignore les erreurs

' l'avantage on boucle une seule fois sur tous les contrôles
    For Each ctrl In UserForm1.Controls
        Select Case TypeName(ctrl)
            Case "Frame"
                CptFram = CptFram + 1
            Case "MultiPage"
                CptMultiPage = CptMultiPage + 1
            Case "TabStrip"
                CptTabStrip = CptTabStrip + 1
        End Select
    Next

    ' Configure les événements pour tous les boutons et enregistre la couleur originale
    ReDim ButtonEvents(1 To Me.Controls.Count)
    ReDim OriginalColors(1 To Me.Controls.Count) ' Initialisation du tableau des couleurs

    i = 1
    CptFram = 1
    CptMultiPage = 1
    CptTabStrip = 1

            ' l'avantage on boucle une seule fois sur tous les contrôles
    For Each ctrl In UserForm1.Controls

            ' Enregistre la couleur originale du bouton
        If TypeOf ctrl Is MSForms.CommandButton Then
            Set ButtonEvents(i) = New ClsButtonEvents
            Set ButtonEvents(i).Button = ctrl
            OriginalColors(i) = ctrl.BackColor
            i = i + 1
        End If

        Select Case TypeName(ctrl)
        ' ici on gère la collection des frames
            Case "Frame"
                CptFram = CptFram + 1
                ReDim Preserve FrameEvt(1 To CptFram)
                Set FrameEvt(CptFram) = New FrameEvent
                Set FrameEvt(CptFram).FrameLRD = ctrl
        ' ici on gère la collection des MultiPages
            Case "MultiPage"
                ReDim Preserve MultiPageEvt(1 To CptMultiPage)
                Set MultiPageEvt(CptMultiPage) = New MultiPageEvent
                Set MultiPageEvt(CptMultiPage).MultiPageLRD = ctrl
                CptMultiPage = CptMultiPage + 1
        ' ici on gère la collection des TabStrip
            Case "TabStrip"
                ReDim Preserve TabStripEvt(1 To CptTabStrip)
                Set TabStripEvt(CptTabStrip) = New TabStripEvent
                Set TabStripEvt(CptTabStrip).TabStripLRD = ctrl
                CptTabStrip = CptTabStrip + 1
        End Select
    Next

End Sub

merci

Bonsoir,

si cela vous plait, alors je suis ravis !
En allant au "fond" de l'idée mon fichier final :

Bonne continuation !

@ bientôt

LouReeD

c'est ce que j’appelle du LOURD (LouReeD)

excellent

je vais continuer sur le principe, et ajouter tous ce qui possible d'ajouter ( textbox, combobox, ....) et essayer d'avoir le changement de couleur, comme cela se serais pour moi une base pour différent fichiers excel a faire

merci

P.S, je te tiendrais au courant de Evolution du fichier

Bonjour a tous

Bonjour @LouReeD

Je te remercie pour ton travail une 2ieme fois

j'ai essayer de comprendre les Modules de class; et j'ai suivie ton raisonnement ( qui est LE Raisonnement a faire)

j'ai appliqué la meme choses pour les ToggleButton, .... Mais.....tans qu'il y a 2 ca fonctionne bien, mais.... des-que j'ajoute un 3 ieme, il y a des scintillements!!!

je ne sais pas ou est ce que je plante!!!

merci pour l'aide

Bonjour,

peut-être que ce type de bouton provoque cela...
La solution trouvée pour diminuer considérablement le scintillement : Créer un interrupteur de "bouton dont la couleur a changé".
plus simplement ModifColor As Boolean

On le passe à True si l'un ou l'autre type de bouton a changé de couleur (rouge ou vert) et on le passe à FALSE dès qu'on restitue les couleurs.
Dans les modules de classe on ne lance la mise à l'original des couleur que s'il existe au moins un bouton modifié, donc si ModifColor = TRUE.

Comme cela le déplacement de la souris sur le USF par exemple ne lance pas à répétition la mise à l'origine des couleurs, cela se produit que lorsque c'est nécessaire.

Le fichier ainsi modifié :

En écrivant ces lignes il me vient une autre idée : mettre en mémoire le "numéro" du bouton dont on a modifié la couleur, et la mise à l'original ne se ferait que sur ce dernier plutôt de de scanner l'ensemble des boutons... A voir...

@ bientôt

LouReeD

Voici donc l'idée du message précédent !

Il n'y a plus qu'un seul tableau de couleurs d'origine pour les boutons, il s'agrandi et s'incrémente avec la variable CptBouton.
on garde les différentes classes bouton afin de réagir en fonction du contrôle survolé, mais ces tableaux s'agrandissent avec la même variable CptBouton, il y a donc des "trous" dedans mais ce n'est pas grave...
Lors de l'ouverture du USF pour les boutons "tous types", on inscrit dans le Tag son nom "virgule" son numéro (CptBouton).

Lorsque l'on met au rouge ou au vert un bouton, on récupère ce Tag dans la variable QuelBouton.
Lorsque le code de mise à jour des couleurs est lancé, on SPLIT la variable QuelBouton sur la virgule, on obtien alors et le nom du contrôle concerné et l'index de sa couleur d'origine dans la variable Tablo(0) et Tablo(1)

Et voilà, on ne modifie en couleur d'origine uniquement le contrôle dont sa couleur avait changé. On n'a plus de scintillement...

et les codes :
du module :

Public ButtonEvents() As ClsButtonEvents
Public FrameEvt() As FrameEvent
Public MultiPageEvt() As MultiPageEvent
Public TabStripEvt() As TabStripEvent
Public ToggleButtonEvt() As ToggleButtonEvent
Public OriginalColors() As Long
Public QuelBouton As String
Sub Bouton()
    UserForm1.Show
End Sub
Sub RemiseDesCouleurs()
    Dim Tablo
    If QuelBouton <> "" Then
        ' on récupère le nom du bouton et sa position dans le tableau
        Tablo = Split(QuelBouton, ",")
        UserForm1.Controls(Tablo(0)).BackColor = OriginalColors(Tablo(1))
        ' on vide la variable QuelBouton vu qu'il n'y a plus de bouton dont la couleur à changer
        QuelBouton = ""
    End If
End Sub

du USF :

Private Sub UserForm_Initialize()
    Dim Ctrl As Control, CptBouton As Integer, CptFram As Integer, CptMultiPage As Integer, CptTabStrip As Integer
    On Error Resume Next 'Ignore les erreurs
    CptBouton = 1: CptFram = 1: CptMultiPage = 1: CptTabStrip = 1
    ' on boucle une seule fois sur tous les contrôles
    For Each Ctrl In UserForm1.Controls
        Select Case TypeName(Ctrl)
            Case "Frame"
                ReDim Preserve FrameEvt(1 To CptFram)
                Set FrameEvt(CptFram) = New FrameEvent
                Set FrameEvt(CptFram).FrameLRD = Ctrl
                CptFram = CptFram + 1
            Case "MultiPage"
                ReDim Preserve MultiPageEvt(1 To CptMultiPage)
                Set MultiPageEvt(CptMultiPage) = New MultiPageEvent
                Set MultiPageEvt(CptMultiPage).MultiPageLRD = Ctrl
                CptMultiPage = CptMultiPage + 1
            Case "TabStrip"
                ReDim Preserve TabStripEvt(1 To CptTabStrip)
                Set TabStripEvt(CptTabStrip) = New TabStripEvent
                Set TabStripEvt(CptTabStrip).TabStripLRD = Ctrl
                CptTabStrip = CptTabStrip + 1
            Case "CommandButton"
                ReDim Preserve ButtonEvents(1 To CptBouton)
                ReDim Preserve OriginalColors(1 To CptBouton)
                Set ButtonEvents(CptBouton) = New ClsButtonEvents
                Set ButtonEvents(CptBouton).ButtonLRD = Ctrl
                Ctrl.Tag = Ctrl.Name & "," & CptBouton
                OriginalColors(CptBouton) = Ctrl.BackColor
                CptBouton = CptBouton + 1
            Case "ToggleButton"
                ReDim Preserve ToggleButtonEvt(1 To CptBouton)
                ReDim Preserve OriginalColors(1 To CptBouton)
                Set ToggleButtonEvt(CptBouton) = New ToggleButtonEvent
                Set ToggleButtonEvt(CptBouton).ToggleButtonLRD = Ctrl
                Ctrl.Tag = Ctrl.Name & "," & CptBouton
                OriginalColors(CptBouton) = Ctrl.BackColor
                CptBouton = CptBouton + 1
        End Select
    Next
End Sub
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    RemiseDesCouleurs
End Sub

J'ai également ajouté aléatoirement "LRD" aux modules de classes Button car ces dernières "embarques" un paramètre du même nom (Button As Integer) et dans VBA il faut éviter les homonymes...

Public WithEvents ButtonLRD As MSForms.CommandButton
Private Sub ButtonLRD_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.ButtonLRD.BackColor = RGB(255, 0, 0) ' Rouge au passage de la souris
    QuelBouton = Me.ButtonLRD.Tag
End Sub

Private Sub ButtonLRD_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.ButtonLRD.BackColor = RGB(0, 255, 0) ' Vert lors du clic
    QuelBouton = Me.ButtonLRD.Tag
End Sub

Public WithEvents ToggleButtonLRD As MSForms.ToggleButton
Private Sub ToggleButtonLRD_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.ToggleButtonLRD.BackColor = RGB(255, 0, 0) ' Vert lors du clic
    QuelBouton = Me.ToggleButtonLRD.Tag
End Sub
Private Sub ToggleButtonLRD_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    Me.ToggleButtonLRD.BackColor = RGB(0, 255, 0) ' Vert lors du clic
    QuelBouton = Me.ToggleButtonLRD.Tag
End Sub

@ bientôt

LouReeD

Bonsoir @LouReeD

.....No Comment.....

Je suis bouche baie

je n'ai plus qu'a l'adapter a tous es fichiers ( je crois qu'il n'y a plus rien a ajouter)

merciiiiiiii.

PS: ou est ce que tu a été formé???

Ici...

@ bientôt

LouReeD

Et avec mes 51 applications !

Surtout les jeux qui engendre des "problèmes " qu'il faut résoudre... Cela me force à trouver LA solution, rapide, fiable et transparente...

@ bientôt

LouReeD