XL 2016 Userform multiples checkbox avec procédures événementielles

Asters · 22 Juillet 2019

Bonjour à vous ,
Je suis bloqué dans un userform, je n'ai pas un niveau de vba très poussé mais en général j'arrive à mes fins. Sauf que là je sèche :
J'ai plusieurs checkbox nommés spécifiquement et numérotés de 1 à 10, je souhaiterais que le fait de cocher un checkbox1 ait une action sur un textbox1 et un label1 (les masquer si c'est décoché ou les afficher si c'est coché) et que cela complète un tableur. Je pourrais coder sur chaque événement checkbox_change mais je vais avoir un grand nombre de situations similaires à coder (avec différentes actions) et je souhaite par ailleurs apprendre de nouvelles méthodes pour progresser.
J'ai dû les nommer spécifiquement car il y aura plusieurs checkbox pour une même page (d'un multipage).
Je précise avoir fait des recherches et fait des essais avec des modules de classe mais les checkbox en question n'étaient pas nommés spécifiquement et la procédure s'appliquait à tous les checkbox. En l’occurrence, je veux cibler certains checkbox situés sur les différentes pages d'un multipage.
Voici le code que je souhaite automatiser :

VB:

Private Sub OffreIRrmail1_Change()
Select Case OffreIRrmail1.Value
Case True:
LaboffreIRmail1.Visible = True
MotifoffreIRrmail1.Visible = True
Worksheets("Feuil1").Range("B6") = "Oui"
Case False:
LaboffreIRmail1.Visible = False
MotifoffreIRrmail1.Visible = False
Worksheets("Feuil1").Range("B6") = "Non"
End Select
End Sub
Private Sub MotifoffreIRrmail1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Worksheets("Feuil1").Range("C6") = MotifoffreIRrmail1
End Sub

Private Sub OffreIRrmail2_Change()
Select Case OffreIRrmail2.Value
Case True:
LaboffreIRmail2.Visible = True
MotifoffreIRrmail2.Visible = True
Worksheets("Feuil1").Range("B7") = "Oui"
Case False:
LaboffreIRmail2.Visible = False
MotifoffreIRrmail2.Visible = False
Worksheets("Feuil1").Range("B7") = "Non"
End Select
End Sub

Private Sub MotifoffreIRrmail2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Worksheets("Feuil1").Range("C7") = MotifoffreIRrmail2
End Sub

Je vous joins aussi un exemple de ce que je veux faire.
Je vous remercie par avance de toute l'aide que vous pourrez m'apporter à ce propos.
Bonne journée à vous.

Valtrase · 23 Juillet 2019

Bonsoir Aster,
Il y a des incompatibilités dans ce que tu dis ou que tu veux faire.
si tu veux qu'un TextBox ne soit plus visible quand tu coches un checkbox tu doit utiliser la méthode Change du dis checkbox. Mais tu peux alléger le code, pour ma part j'utilise le .Tag dans un module tu colle ce code.
La fonction GetTheValue va chercher dans .Tag une valeur bien spécifique. comme tu pourras le voir cette fonction n'est pas de mon cru.

VB:

Private Sub CheckBoxChange(Element As Object)
'Dans le .tag de tes checkBox tu devra mettre les noms des boutons, label et range dans le style
' MyTextBox:=MotifoffreIRrmail2;MyLabel:=LaboffreIRmail1;MyRange:=B6

Me.Controls(GetTheValue(Element.Tag, "MyTextBox")).Visible = Element.Value
Me.Controls(GetTheValue(Element.Tag, "MyLabel")).Visible = Element.Value
Worksheets("Feuil1").Range(GetTheValue(Element.Tag, "MyRange")) = IIf(Element.Value = True, "OUI", "NON")

End Sub
Public Function GetTheValue(strTag As String, strValue As String) As String
' *************************************************************
' Erstellt von     : Avenius
' Parameter        : Input String, SuchValue String
' Erstellungsdatum : 05.01.2008
' Bemerkungen      :
' Änderungen       :
'
' Beispiel
' getTheValue("DefaultValue:=Test;Enabled:=0;Visible:=1", "DefaultValue")
' Return           : "Test"
' *************************************************************

    On Error Resume Next

    Dim workTb() As String
    Dim Ele() As String
    Dim myVariabs() As String
    Dim i As Integer

    workTb = Split(strTag, ";")

    ReDim myVariabs(LBound(workTb) To UBound(workTb), 0 To 1)
    For i = LBound(workTb) To UBound(workTb)
        Ele = Split(workTb(i), ":=")
        myVariabs(i, 0) = Ele(0)
        If UBound(Ele) = 1 Then
            myVariabs(i, 1) = Ele(1)
        End If
    Next

    For i = LBound(myVariabs) To UBound(myVariabs)
        If strValue = myVariabs(i, 0) Then
            GetTheValue = myVariabs(i, 1)
        End If
    Next

End Function

Ensuite dans la méthode .Change tu colles

Code:

CheckBoxChange(OffreIRrmail1)

Maintenant si tu veux boucler su tous les CheckBox utilises TypeOf dans le style

Code:

Dim oElements As Object
For Each oElements In Me.Controls
    If TypeOf oElements Is CheckBox Then
        CheckBoxChange oElements
    End If
Next

Le plus dur restant de savoir où mettre ce code.
Un dernier mot je n'est pas tester ce code je reste en attente de tes retours.

ChTi160 · 23 Juillet 2019

Bonjour Alster
Bonjour le Fil (valtrase) ,le Forum

Pas évident de comprendre ce que tu veux faire avec ce que tu as !
Peux tu mettre un exemple plus parlant avec des explications de ce que tu as et ce que tu veux .
Merci par avance
jean marie

Asters · 23 Juillet 2019

Bonjour à vous deux.
Merci d'avoir pris le temps pour regarder mon problème.
valtrase, effectivement c'est sur l’événement change du checkbox que j'ai codé toute ma procédure événementielle et je souhaite boucler sur tous les checkbox du même type
Au lieu de coder 10 fois selon le code ci dessous, je souhaite simplifier pour ne pas avoir à tout coder, ce doit être possible car il n'y a que les numéros qui changent.

Code:

Private Sub OffreIRrmail1_Change()
Select Case OffreIRrmail1.Value
Case True:
LaboffreIRmail1.Visible = True
MotifoffreIRrmail1.Visible = True
Worksheets("Feuil1").Range("B6") = "Oui"
Case False:
LaboffreIRmail1.Visible = False
MotifoffreIRrmail1.Visible = False
Worksheets("Feuil1").Range("B6") = "Non"
End Select
End Sub
Private Sub MotifoffreIRrmail1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Worksheets("Feuil1").Range("C6") = MotifoffreIRrmail1
End Sub
Private Sub OffreINAmail1_Change()
Select Case OffreINAmail1.Value
Case True:
LaboffreINAmail1.Visible = True
MotifoffreINAmail1.Visible = True
Worksheets("Feuil1").Range("D6") = "Oui"
Case False:
LaboffreINAmail1.Visible = False
MotifoffreINAmail1.Visible = False
Worksheets("Feuil1").Range("D6") = "Non"
End Select
End Sub
Private Sub MotifoffreINAmail1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Worksheets("Feuil1").Range("E6") = MotifoffreIRrmail1
End Sub
Private Sub OffreIRrmail2_Change()
Select Case OffreIRrmail2.Value
Case True:
LaboffreIRmail2.Visible = True
MotifoffreIRrmail2.Visible = True
Worksheets("Feuil1").Range("B7") = "Oui"
Case False:
LaboffreIRmail2.Visible = False
MotifoffreIRrmail2.Visible = False
Worksheets("Feuil1").Range("B7") = "Non"
End Select
End Sub
Private Sub MotifoffreIRrmail2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Worksheets("Feuil1").Range("C7") = MotifoffreIRrmail2
End Sub
Private Sub OffreINAmail2_Change()
Select Case OffreINAmail2.Value
Case True:
LaboffreINAmail2.Visible = True
MotifoffreINAmail2.Visible = True
Worksheets("Feuil1").Range("D7") = "Oui"
Case False:
LaboffreINAmail2.Visible = False
MotifoffreINAmail2.Visible = False
Worksheets("Feuil1").Range("D7") = "Non"
End Select
End Sub
Private Sub MotifoffreINAmail2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Worksheets("Feuil1").Range("E7") = MotifoffreINAmail2
End Sub

Chaque contrôle associé à une page est numéroté en fonction du numéro de la page.
Je souhaite que chaque action associée à un contrôle agisse sur certains des contrôles de cette même page.
On coche un check box le label et textbox associé apparaisse et inversement. Si on coche, oui est incrémenté dans la ligne correspondante, si c'est décoché c'est non qui apparaît.
On complète le textbox motif, cela s'incrémente dans le tableur.
Quand on complète les informations sur la page suivante, c'est la ligne suivante du tableur qui est incrémentée
J'ai pu adapter une procédure (ci dessous) pour remplir automatiquement les listes de choix de chaque combobox "Réponse1","Réponse2" ect de mon userform (je ne l'ai pas mise dans le document transmis). Je souhaiterais donc aboutir à une procédure similaire ici, sauf que le fait que ce soit des procédures événementielles me bloque

Code:

Dim I As Integer
For I = 1 To 10
Me.Controls("Réponse" & I).List = Worksheets("Feuil1").Range("A3:A5").Value
Next i

Par ailleurs, j'aurais d'autres contrôles que des check box qui auront des incidences sur certains des contrôles de la page. Comme le fait de cliquer sur un date picker incrémente la date dans un text box qui lui est associé .

VB:

Private Sub Datepickmail1_Click()
Call affichage_calendrier(datemail1)
End Sub
Private Sub Datepickmail2_Click()
Call affichage_calendrier(datemail2)
End Sub

Je souhaiterais donc appliquer la même procédure d'autres objets.
ChTi160, j'ai ajouté un exemple plus détaillé en pj avec quelques autres contrôles sur lesquels je souhaite agir de manière répétitive.
valtrase, j'ai testé le code transmis mais visible ça plante (voir en pj)
Bonne journée.

ChTi160 · 23 Juillet 2019

Re
si je comprends bien , tu vas avoir autant de Pages dans le Multipage que d'offres dans la Feuil1 ?
dans ta feuille Fichier : Exemple , il n'y a qu'une colonne Motif . Pourquoi ?
jean marie

ChTi160 · 23 Juillet 2019

re
On pourrait imaginer un truc du genre (voir Image)
Mais bon ! On a peut être pas toutes les cartes en mains Lol
je viens de relire ton post #4 et effectivement , il y a d'autres Controls .
Peux tu mettre un fichier qui soit représentatif ,merci
jean marie

Valtrase · 24 Juillet 2019

Salut le fil

Bon je ne sais pas si j'ai bien tout compris mais tu peux faire comme indiquer dans mon nouveau code dificile de faire plus court
je 'ai mis que deux lignes pour un textbox et un label
En attente de ton retour.

Valtrase · 25 Juillet 2019

J'ai oublié d'incrémenter la feuille, voilà qui est fait

Asters · 25 Juillet 2019

Valtrase, c'est bien une simplification de ce type que je recherchais et que je puisse m'approprier pour l'adapter dans d'autres situation. C'est chose faite, j'ai même découvert comment se passer du select case des check box grâce à toi et ça va alléger bien mon code (en intégrant l'inverse de true via Not).
Donc un grand merci à toi ainsi qu'à ChTi160 pour le temps passé à m'aider.

Valtrase · 25 Juillet 2019

Quand on peu aider.....

ChTi160 · 25 Juillet 2019

Bonjour Asters
Bonjour le Fil,le Forum
merci , mais j ai pas eu de reponse ,donc pas pu t aider mais bon！
jean marie

ChTi160 · 26 Juillet 2019

Bonjour Jacques
je regarde a tout cela
jean marie

XL 2016 Userform multiples checkbox avec procédures événementielles

Asters

XLDnaute Nouveau

Pièces jointes

Valtrase

XLDnaute Occasionnel

ChTi160

XLDnaute Barbatruc

Asters

XLDnaute Nouveau

Pièces jointes

ChTi160

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

Pièces jointes

Valtrase

XLDnaute Occasionnel

Pièces jointes

Valtrase

XLDnaute Occasionnel

Pièces jointes

Asters

XLDnaute Nouveau

Valtrase

XLDnaute Occasionnel

ChTi160

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

Discussions similaires