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...

Choco2x · 13 Décembre 2020

Ah !
Quelle partie ?
A déplacer ou à supprimer ?

Staple1600 · 13 Décembre 2020

Re

=>JM27

en conclusion son bout code n'a rien à faire à cet endroit là

Je suppose que tu parles du bout de code lié au Ctrl et pas de mon bout ?

En parlant de bout, voici une version améliorée de mon petit bout
(pour lister les contrôles et leur Tag)
Ca peut toujours servir

VB:

Sub Test_Tags_v2()
Dim ctrl As Control, k&, t
Sheets.Add
Application.ScreenUpdating = False: [A1:D1].Font.Bold = -1
[A1:D1] = Array("Nom Contrôle", "Tag (part 1)", "Tag (part 2)", "Tag (part 3)"): k = 2
For Each ctrl In UserFormTransport.Controls
If Len(ctrl.Tag) Then
t = Split(ctrl.Tag)
Cells(k, 1) = ctrl.Name: Cells(k, 2) = t(0): Cells(k, 3) = t(1): Cells(k, 4) = t(2)
End If
k = k + 1
Next
Columns(1).SpecialCells(4).EntireRow.Delete: Columns(1).Columns.AutoFit
[A1].CurrentRegion.Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlYes
[A1].CurrentRegion.Borders.Weight = 2
End Sub

JM27 · 13 Décembre 2020

Je précisais que le bout de code qu'il à rajouté dans la macro de validation n'a rien à faire la.
et je confirme que cela plante quand le nom ou le prénom est nouveau

et pour être encore plus clair

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

Staple1600 · 13 Décembre 2020

Re

Qui ca? Il?
J'ai rien rajouté, moi!
Tu parles de l'autre, JM?
Le Ch'ti, retraité de la Société Nationale des Chemins de Fer

JM27 · 13 Décembre 2020

Non je parles du demandeur .
je ne sais pas qui à proposé ce bout de code , et qui l'a mis à cet endroit !!
je n'ai pas dit que c'était pas bon (je ne me permet pas) , j'ai juste dis que cela n'a rien à faire la.

Choco2x · 13 Décembre 2020

Mieux ?...

Merci !!

J'imagine que je dois en mettre une copie quelque part pour avoir les civilités dans la base de données patients...

JM27 · 13 Décembre 2020

A ben enfin

Et pendant qu'on y est
est tu sur qu'il faut que cela soit à cet endroit la??

VB:

 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

Choco2x · 13 Décembre 2020

Je ne suis sûr de rien, comme tu as pu le comprendre déjà !!
Où dois-je le déplacer ? Ca fonctionne, là, pourtant...
Il n'y a plus qu'une toute petite chose qui coince, et c'est facultatif, c'est le report de la civilité dans la feuille BD Patients...

JM27 · 13 Décembre 2020

Ca marche , mais cela n'a rien à faire à cet endroit

Choco2x · 13 Décembre 2020

J'ai peur de mal le déplacer, avant ou après un If ou un Next que j'aurais raté...
Je n'ose plus toucher à rien...

JM27 · 13 Décembre 2020

Les check box sont écrites avec leur nom dans la macro : pourquoi les mettre dans la boucle ?
donc à déplacer après le next

pour la civilité ( ne pas oublier de déclarer en début de macro LigneDeTransfert en integer ou long )

VB:

 With Sheets("BD patients")
            LigneDeTransfert = .Range("A10000").End(xlUp).Row + 1
           .Range("A" & LigneDeTransfert) = Sheets("Commande").Range("A" & LigneDeDestination)
            .Range("B" & LigneDeTransfert) = Me.ComboNom
            .Range("C" & LigneDeTransfert) = Me.ComboPrénom
            .Range("D" & LigneDeTransfert) = CDate(Me.TxtDateDeNaissance)
  End With

a la place de :

VB:

 With Sheets("BD patients")
            LigneDeDestination = .Range("A10000").End(xlUp).Row + 1
         '  .Range("A" & LigneDeDestination) = Me.ComboBoxCivilité
            .Range("B" & LigneDeDestination) = Me.ComboNom
            .Range("C" & LigneDeDestination) = Me.ComboPrénom
            .Range("D" & LigneDeDestination) = CDate(Me.TxtDateDeNaissance)
        End With

Choco2x · 13 Décembre 2020

' Transfert des strings
.Cells(LigneDeDestination, CByte(Split(ctrl.Tag, " ")(0))) = ctrl.Value
End Select
End If
Next
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
End With

il me dit "Next sans for"... Je l'ai mal positionné ?...

JM27 · 13 Décembre 2020

Il y a aussi le dernier end if qui n'a rien a faire la
Si tu rajoutes de l'indentation ( retrait des ligne conditionnées) , cela sera plus facile d'analyser
( faire de l'indentation en général entre deux textes écrit en "bleu")
exemple :
If , end if
with , end with
on error resume next ; on error goto 0
for , next

etc.

et voila

VB:

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
                                 Select Case Split(ctrl.Tag, " ")(0)
                                   Case "1", "6"
                                       If ctrl.Value = True Then .Cells(LigneDeDestination, CByte(Split(ctrl.Tag, " ")(0))) = ctrl.Caption
                                   Case Else 'ajout ici
                                ' Transfert des strings
                                    .Cells(LigneDeDestination, CByte(Split(ctrl.Tag, " ")(0))) = ctrl.Value
                                  End Select
                            End If
                    End If
                          
            Next
                    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 With

Choco2x · 13 Décembre 2020

J'ai mis çà en haut de la macro, en plus du code du post 86...

Public LigneDeDestination As Long (déjà là...)
Public LigneDeTransfert As Long

JM27 · 13 Décembre 2020

extrait de l'aide VBA
Dim, instruction
Déclare des Lien supprimé et attribue de l'espace de stockage.
Dim, instruction
Les variables déclarées à l'aide de l'instruction Dim au Lien supprimé sont disponibles pour toutes les procédures duLien supprimé. Au Lien supprimé, les variables ne sont disponibles qu'au sein de la procédure.
voir aussi portée des variables et espace de stockage de celle ci

Utilisez l'instruction Dim au niveau module ou au niveau procédure pour déclarer le type de données d'une variable. Par exemple, l'instruction suivante déclare une variable comme variable de type Integer.

Non public doit se mettre dans un module standard
Private ( ou dim ) en tête d'un module en particulier
et dim en tête de procédure
dim LigneDeTransfert As Long

XL 2016 CheckBox et OptionButon

Choco2x

XLDnaute Occasionnel

Pièces jointes

Choco2x

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

JM27

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

JM27

XLDnaute Barbatruc

Choco2x

XLDnaute Occasionnel

Pièces jointes

JM27

XLDnaute Barbatruc

Choco2x

XLDnaute Occasionnel

JM27

XLDnaute Barbatruc

Choco2x

XLDnaute Occasionnel

JM27

XLDnaute Barbatruc

Choco2x

XLDnaute Occasionnel

JM27

XLDnaute Barbatruc

Choco2x

XLDnaute Occasionnel

JM27

XLDnaute Barbatruc

Discussions similaires