XL 2016 CheckBox et OptionButon

Choco2x · 13 Décembre 2020

Bonjour à toutes et à tous !

J'ai trouvé beaucoup de réponses concernant ce que je cherche, mais chaque fois soit je n'ai pas réussi à l'adapter, soit ça ne correspondait pas à mes besoins...
Précision : je suis d'un niveau très faible en VBA, si je suis déjà allé aussi loin c'est uniquement grâce à votre aide (surtout JM27 ).

J'ai deux problèmes :
- J'ai un formulaire avec des CheckBox, et quand je coche les cases pour les retrouver dans la feuille "Commande", les résultats vont toujours sur la ligne 3
, remplaçant chaque fois le résultat précédent, au lieu d'aller juste en dessous, sur la ligne correspondant à la nouvelle entrée du formulaire.

- Ensuite, mais c'est plus optionnel, je n'arrive pas à remplacer les ComboBoxCivilité et ComboTps par des OptionButon, tout en résupérant les résultats dans la feuille "Commande" pour les deux, et dans la feuille "BD Patients" pour la civilité.

La userform est en vrac, je sais, mais j'ai changé si souvent que j'attends à présent que tout fonctionne pour la mettre en forme...

Quelqu'un pourrait-il m'aider ?...

Merci d'avance...

Robert · 13 Décembre 2020

Bonjour Choco, bonjour le forum,

Peut-être ici :

VB:

        If ChkBxContentions.Value = True Then
            Range("Q").Value = "X"
        End If
        If ChkBxBar.Value = True Then
            Range("P").Value = "X"
        End If
        If ChkBxBMR.Value = True Then
            Range("N").Value = "X"
        End If
        If ChkBxCOV.Value = True Then
            Range("O").Value = "X"
        End If
        If ChkBxO2.Value = True Then
            Range("M").Value = "X"
        End If

Remplace par :

Code:

        If ChkBxContentions.Value = True Then
            .Cells(LigneDeDestination, "Q").Value = "X"
        End If
        If ChkBxBar.Value = True Then
            .Cells(LigneDeDestination, "P").Value = "X"
        End If
        If ChkBxBMR.Value = True Then
            .Cells(LigneDeDestination, "N").Value = "X"
        End If
        If ChkBxCOV.Value = True Then
            .Cells(LigneDeDestination, "O").Value = "X"
        End If
        If ChkBxO2.Value = True Then
            .Cells(LigneDeDestination, "M").Value = "X"
        End If

Robert · 13 Décembre 2020

Re,

Pour l'autre problème, la partie entre les commentaires ***

Code:

With Sheets("Commande")
    ' Je définie la ligne de destination dans la base de données ' dernière ligne documentée +1
    LigneDeDestination = .Range("A65536").End(xlUp).Row + 1
    For Each Ctrl In Me.Controls
        ' Je tranfère les données en fonction de leur type ( numérique , date, string)
        If Ctrl.Tag <> "" Then
            ' transfert des dates
            If Split(Ctrl.Tag, " ")(2) = "date" Then
                 .Cells(LigneDeDestination, CByte(Split(Ctrl.Tag, " ")(0))) = CDate(Ctrl.Value)
                ' Transfert des valeures numérique
            ElseIf Split(Ctrl.Tag, " ")(2) = "num" Then
                .Cells(LigneDeDestination, CByte(Split(Ctrl.Tag, " ")(0))) = CDbl(Ctrl.Value)
            Else
          
            '*****************************************************************************************
                On Error Resume Next
                Select Case Split(Ctrl.Tag, "-")(0)
                    If Err > 0 Then
                        Err.Clear
                        GoTo suite
                    End If
                    Case "1", "6"
                        If Ctrl.Value = True Then .Cells(LigneDeDestination, CByte(Split(Ctrl.Tag, "-")(0))) = Ctrl.Caption
                End Select
suite:
                On Error GoTo 0

           '*****************************************************************************************
          
            ' Transfert des strings
                .Cells(LigneDeDestination, CByte(Split(Ctrl.Tag, " ")(0))) = Ctrl.Value
            End If
            If ChkBxContentions.Value = True Then
                .Cells(LigneDeDestination, "Q").Value = "X"
            End If
            If ChkBxBar.Value = True Then
                .Cells(LigneDeDestination, "P").Value = "X"
            End If
            If ChkBxBMR.Value = True Then
                .Cells(LigneDeDestination, "N").Value = "X"
            End If
            If ChkBxCOV.Value = True Then
                .Cells(LigneDeDestination, "O").Value = "X"
            End If
            If ChkBxO2.Value = True Then
                .Cells(LigneDeDestination, "M").Value = "X"
            End If
    End If
Next
End With

Choco2x · 13 Décembre 2020

Bonjour Robert !

Ca fonctionne ! Je savais bien que c'était encore mon ignorance en matière de syntaxe qui me faisait planter !!

Merci pour cette réponse simple et adaptée, car bien souvent je tombe sur des discussions déjà tellement plus poussées que me connaissances que je n'arrive pas à appliquer ce que je lis...

Choco2x · 13 Décembre 2020

Ah, je n'avais pas vu la suite, je tente !

Choco2x · 13 Décembre 2020

Je n'ai qu'à insérer çà, sans rien faire d'autre, avec les Tag tels quels etc ?

Robert · 13 Décembre 2020

Re,

Non testé... Je pense que oui mais j'ai modifié deux fois déjà... Donc fait-le avec la dernière modif...

Choco2x · 13 Décembre 2020

Je n'avais pas vu!

Il me met "Instructions et étiquettes incorrectes entre select case etle premier case"...

Et il surligne "Err".

Robert · 13 Décembre 2020

Re

Peut-être comme ça alors :

VB:

                '**********************************************
                On Error Resume Next
                Select Case Split(Ctrl.Tag, "-")(0)
                    Case "1", "6"
                        If Ctrl.Value = True Then .Cells(LigneDeDestination, CByte(Split(Ctrl.Tag, "-")(0))) = Ctrl.Caption
                End Select
                On Error GoTo 0
                '**********************************************

Choco2x · 13 Décembre 2020

Choco2x · 13 Décembre 2020

Les champs concernés (civilité et transport) ont des tag non...

Choco2x · 13 Décembre 2020

Et je ne m'en sers pas durant mes tests, puisque le butest de les remplacer par des boutons d'option...
Est-ce une erreur de ma part ?

Je vais les supprimer carrément sinon...

ChTi160 · 13 Décembre 2020

Bonjour Choco2x
Bonjour le fil (Robert) ,le Forum
que contient le Tag du Ctrl
car dans la procédure de Robert tu as

Split(Ctrl.Tag, "-"

et dans ton code

Split(Ctrl.Tag, " "

est ce normal ?
Pourquoi des OptionButton plus complique à gérer qu'un ComboBox
dans ton code tu as pour charger le ComboBox des Civilités

VB:

For Each Cell In .Range("AD2:AD" & .Range("AD10").End(xlUp).Row)
           Me.ComboBoxCivilité.AddItem (Cell)
Next

alors que les Civilités sont en Colonne "AA" et Non "AD"
Pour éviter une Boucle ,tu pourrais mettre

VB:

Me.ComboBoxCivilité.List = Array("", "Mme", "Melle", "M.")

Bonne journée
jean marie

Choco2x · 13 Décembre 2020

Bonjour ChTi !

Dans les Tags des objets, j'ai par exemple 1-1, 1-2, 1-3 pour le 1er, puis 6-1 et 6-2 pour le deuxime...
Mix de ce que j'ai trouvé dans les différentes discussions...

Pour le code, je ne l'ai pas fait, j'ai été - très - aidé, mais ça fonctionne bien, non ?

Pourquoi des OptionButton ?
Pour la présentation, surtout, et pour apprendre, je pense...

Mais comme je disais, c'est optionnel !

Robert · 13 Décembre 2020

Re,

J'ai modifié les propriétés Tag des OptionButtons 1-1 devient 1 oui 1, 6-1 devient 6 oui 1, etc.
Le code devient :

VB:

                            '**********************************************
                            Select Case Split(Ctrl.Tag, " ")(0)
                                Case "1", "6"
                                    If Ctrl.Value = True Then .Cells(LigneDeDestination, CByte(Split(Ctrl.Tag, " ")(0))) = Ctrl.Caption
                            End Select
                            '**********************************************

Ça devrait marcher mais il faut supprimer les deux Comboboxes et ça impacte beaucoup de code (alimentation de ces deux comboboxes, etc.)

Comme tu dis, ça fonctionne bien ! Alors laisse comme c'est si tu n'es pas maître du code. Même si c'est une usine à gaz qui tient plus de la mas*****tion intellectuelle que de l'efficacité...

XL 2016 CheckBox et OptionButon

Choco2x

XLDnaute Occasionnel

Pièces jointes

Robert

XLDnaute Barbatruc

Robert

XLDnaute Barbatruc

Choco2x

XLDnaute Occasionnel

Choco2x

XLDnaute Occasionnel

Choco2x

XLDnaute Occasionnel

Robert

XLDnaute Barbatruc

Choco2x

XLDnaute Occasionnel

Robert

XLDnaute Barbatruc

Choco2x

XLDnaute Occasionnel

Choco2x

XLDnaute Occasionnel

Choco2x

XLDnaute Occasionnel

ChTi160

XLDnaute Barbatruc

Choco2x

XLDnaute Occasionnel

Robert

XLDnaute Barbatruc

Discussions similaires