Eviter les doublons sur une Liste déroulante avec userform

[MOLLE]

Bonjour à tous,

Je travaille actuellement sur un formulaire qui doit me permettre de saisir des données plus simplement. J'avais déjà utilisé le même formulaire sur un autre projet qui fonctionne très bien et j'ai donc tout repris en modifiant seulement quelques petites choses. Mon soucis, c'est que mes listes déroulantes sont vides malgré que j'ai un tb.additem... qui fonctionnait très bien avant. Est-ce que quelques experts peuvent jeter un œil à mon projet car je ne comprend pas pourquoi ça ne fonctionne pas. Il y a certainement d'autres erreurs mais je n'ai pas pu tester pour le moment. C'est la macro formulaire qui permet de lancer le programme.

Merci par avance,

 

[JM27]

bonsoir
remplaces
Private Sub UserForm1_Initialize()

par

Private Sub UserForm_Initialize()

je n'ai pas regardé la suite( qui a quelques pb)

par exemple For I = 1 To 95

or il n'y a que 70 textbox
donc
For I = 1 To 70
Me.Controls("TB" & I).Visible = True
next I
pourquoi les rendre visible car elles le sont déja !
en plus cela sert à quoi de changer les couleur des contrôles à l'initialyse ( sans effet)

 

[Lone-wolf]

Bonsoir MOLLE et bienvenue sur XLD

Je ne sais pas comment, sur l'autre formulaire, tu n'a pas de problèmes; par-ce que c'est comme ceci qu'on rempli une combobox

With TB1
.AddItem "Stable"
.AddItem "Précaire"
.AddItem "Sans"
.AddItem "Non renseigné"
End With

Et pourquoi les avoir renommés?? . Ensuite

For I = 1 To 95
Me.Controls("TB" & I).Visible = True 'affiche les données dans les textbox
Next I

Pourquoi cette boucle?? , ça n'affiche pas les données, mais rend visible les textbox.

Pour la mise en forme des contrôles, Met en haut du formulaire Dim ctrl As Control

   'DANS USF INITIALIZE
    Me.BackColor = RGB(135, 206, 250)
    Me.MultiPage1.BackColor = RGB(135, 206, 250)

Private Sub UserForm_Activate()
For Each ctrl In Me.Controls
If TypeName(ctrl) = "Label" Then ctrl.BackStyle = 0
Next ctrl

For Each ctrl In Me.Controls
If TypeName(ctrl) = "OptionButton" Or TypeName(ctrl) = "Frame" _
Or TypeName(ctrl) = "CommandButton" Then ctrl.BackColor = RGB(135, 206, 250)
Next ctrl
End Sub

Entre nous je te conseille de refaire le formulaire sans modifier le nom des contrôles.

EDIT: bonsoir JM27

 

[MOLLE]

Merci à vous, je vais jeter un oeil. J'avais été aidé à l'origine car je débute en vba et c'était mon premier formulaire. Pour l'histoire de la visibilité des textbox, il y en a 2 qui sont cachées derrière nom et prénom pour récupérer les données qui sont saisies (tb83 et tb84). De plus il y a une question de doublons pour le prénom en fonction du nom quand je modifie une fiche patient car je peux avoir des personnes ayant le même nom mais pas le même prénom.
Pour les textbox il y en a bien 95 je crois.

 

[Lone-wolf]

Re

Pour ne pas avoir de problème, il faut inserer une nouvelle colonne A en l'occurence. Ensuite, dans le bouton d'enregistrement. Avec la combo de recherche, tu sélectionne un nom et tu modifie en conséquence. Et comment tu peux avoir 95 textbox sans compter le reste; alors qu'il y a 34 colonnes dans la feuille 2017 ???

Si tu refait le formulaire, sans renommer les contrôles, ça va se résumer à ceci. Met les 34 textbox, puis supprime la textbox1.

'En haut du formulaire
Dim lig As Long, i As Long, rw

Private Sub Ajouter()
'Tu aura un ID unique et donc pas de risque d'erreurs.

lig = Range("a" & Rows.Count).End(xlUp).Row + 1

Cells(lig, "A") = TextBox2 & TextBox3 & "-" & lig - 1

For i = 2 to 34
       Cells(lig, i) = Controls("TextBox" & i)
Next i
End Sub

'Ensuite tu ajoute une combo de recherche _
en la remplissant avec la colonne A(dans Usf_Initialize()), puis tu ajoute ceci

Private Sub ComboBox1_Change()
    If ComboBox10 <> "" Then
         Call Recherche
    Else
            Exit Sub
    End If
End Sub

Private Sub Recherche()
Dim rw, i As Long
        With Sheets(2)
                  rw = Application.Match(ComboBox1, .Columns(1), 0)
                   For i = 2 To 34
                            Controls("TextBox" & i)  = .Cells(rw, i)       
                     Next i
        End With
End Sub

Private Sub Modifier()
With Sheets(2)
           rw = Application.Match(ComboBox1, .Columns(1), 0)
      For i = 2 To 34
               .Cells(rw, i) = Controls("TextBox" & i)
       Next i
End With
End Sub

Pour supprimer un enregistrement, tu copie la macro modifier et tu modifie comme ceci

With Sheets(2)
rw = Application.Match(ComboBox1, .Columns(1), 0)
.Rows(rw).EntireRow.Delete
End With

 

[MOLLE]

Bonjour,

J'ai suivi vos conseils et modifié pas mal de choses dans mon fichier pour que ce soit plus logique. Il ne me reste qu'un seul soucis, c'est que quand je souhaite modifier une fiche patient, les données que je récupère après avoir sélectionné le Nom et le prénom ne sont pas au bon endroit. Tout est mélangé et je ne comprends pas trop pourquoi.
Pouvez-vous m'aider sur ce point. Je vous joins le fichier pour que ce soit plus facile à comprendre pour vous. Je suis débutant donc c'est assez compliqué pour moi le vba.
Merci par avance pour votre aide

 

[Lone-wolf]

Bonjour MOLLE

Moi je ne vois rien de changer dans le fichier que tu as mis, si c'est comme ça que tu suis les conseils.... . Je t'ai donné l'exemple de comme fallait faire, mais que dalle.

 

[MOLLE]

Au niveau des modifications, j'ai renommé toutes les textbox ainsi que les frames pour les mettre dans l'ordre et donc le code en vba aussi. Je viens aussi d'ajouter la fonction que tu m'as dis pour les contrôles et ça fonctionne enfin. Et pour l'histoire de remettre une combobox de recherche, j'ai pas compris. Il faut que je rajoute une combobox et que je recrée une colonne A? Je suis un débutant en vba donc j'ai très peu de notions et j'essaie de comprendre petit à petit.

 

[Lone-wolf]

Re

Oui. Et comme montré dans le post (macros), dans le bouton d'enregistement

Private Sub Ajouter()
'Tu aura un ID unique et donc pas de risque d'erreurs.

lig = Range("a" & Rows.Count).End(xlUp).Row + 1
                               '1ère lettre du nom+1ère lettre du prénom+ n°ligne
Cells(lig, "A") = Left(TextBox2, 1) & Left(TextBox3, 1) & "-" & lig - 1

For i = 2 to 34
       Cells(lig, i) = Controls("TextBox" & i)
Next i
End Sub

 

[MOLLE]

Désolé mais je vois pas où je dois ajouter le bout de code. Aussi je ne comprends pas l'histoire de la combobox de recherche ni la création d'une nouvelle colonne A. Peux-tu m'expliquer s'il te plaît?
Merci de ton aide

 

[Lone-wolf]

Re

Comme tu va avoir des doublons voir des quadruples doublons, pour faire une modification ou une suppression d'une ligne, tu dois avoir un colonne avec un id unique, en l'occurence la colonne A. Et Pour la combo, relit ce que j'ai écrit.

 

[MOLLE]

Il faut que je crée une colonne A ou j'ai un id unique du type 01, 02 etc? Dans le 1er projet que j'ai utilisé (ressemble à ce fichier), quand je souhaitais modifier une fiche, je selectionnais un nom dans la liste deroulante puis un prénom. Si il y avait 2 patients qui avaient le même nom, j'avais plusieurs prénoms et je choisissais celui que je souhaitais modifier. Après avoir sélectionné le prénom, toutes les autres textbox se remplissaient. En fait, c'est l'action de sélectionner le prénom qui declenche la suite. J'ai repris cette fonction que j'ai remis dans mon document mais ça marche que partiellement car les textbox récupérées ne s'affichent pas au bon endroit. C'est aussi pour ça que ça m'embête de tout remodifier car ça fonctionnait avant mais je ne trouve pas où est l'erreur.

 

[MOLLE]

J'ai besoin d'aide les amis pour l'histoire des doublons car je récupère les informations mais pas dans les bonnes textbox. J'ai une suite en tête avec une autre fonction pour après, mais il faut déjà que je résolve ce soucis. Je vous mets un bout de mon code actuel:

'Correspond au programme de la LISTE DEROULANTE "NOM"
Private Sub ComboBox1_Change()
Dim J As Long

Nettoyage 'Lance le programme Nettoyage

Me.ComboBox2.Clear 'Efface les données de la combobox2
If Me.ComboBox1.ListIndex = -1 Then Exit Sub
With Me.ComboBox2
For J = 2 To NbLignes
If Ws.Range("A" & J) = Me.ComboBox1 Then
.AddItem Ws.Range("B" & J)
.List(.ListCount - 1, 1) = J
End If
Next J
End With
End Sub

Private Sub ComboBox2_Change()
Dim Ligne As Long
Dim I As Integer
Dim TB
Nettoyage 'Lance le programme Nettoyage
If Me.ComboBox2.ListIndex = -1 Then Exit Sub
Ligne = Me.ComboBox2.List(Me.ComboBox2.ListIndex, 1)
For I = 1 To 33
Me.Controls("TB" & I) = Ws.Cells(Ligne, I + 2)
Next I


If TB16.Value = "Oui" Then
OptionButton1.Value = True
OptionButton2.Value = False
OptionButton3.Value = False
Else
If TB16.Value = "Non" Then
OptionButton1.Value = False
OptionButton2.Value = True
OptionButton3.Value = False
Else
If TB16.Value = "Non renseigné" Then
OptionButton1.Value = False
OptionButton2.Value = False
OptionButton3.Value = True
End If
End If
End If

If TB17.Value = "Oui" Then
OptionButton4.Value = True
OptionButton5.Value = False
OptionButton6.Value = False
Else
If TB17.Value = "Non" Then
OptionButton4.Value = False
OptionButton5.Value = True
OptionButton6.Value = False
Else
If TB17.Value = "Non renseigné" Then
OptionButton4.Value = False
OptionButton5.Value = False
OptionButton6.Value = True
End If
End If
End If

If TB18.Value = "Oui" Then
OptionButton7.Value = True
OptionButton8.Value = False
OptionButton9.Value = False
Else
If TB18.Value = "Non" Then
OptionButton7.Value = False
OptionButton8.Value = True
OptionButton9.Value = False
Else
If TB18.Value = "Non renseigné" Then
OptionButton7.Value = False
OptionButton8.Value = False
OptionButton9.Value = True
End If
End If
End If

If TB19.Value = "Oui" Then
OptionButton10.Value = True
OptionButton11.Value = False
OptionButton12.Value = False
Else
If TB19.Value = "Non" Then
OptionButton10.Value = False
OptionButton11.Value = True
OptionButton12.Value = False
Else
If TB19.Value = "Non renseigné" Then
OptionButton10.Value = False
OptionButton11.Value = False
OptionButton12.Value = True
End If
End If
End If

If TB20.Value = "Oui" Then
OptionButton13.Value = True
OptionButton14.Value = False
OptionButton15.Value = False
Else
If TB20.Value = "Non" Then
OptionButton13.Value = False
OptionButton14.Value = True
OptionButton15.Value = False
Else
If TB20.Value = "Non renseigné" Then
OptionButton13.Value = False
OptionButton14.Value = False
OptionButton15.Value = True
End If
End If
End If

If TB21.Value = "Oui" Then
OptionButton16.Value = True
OptionButton17.Value = False
OptionButton18.Value = False
Else
If TB21.Value = "Non" Then
OptionButton16.Value = False
OptionButton17.Value = True
OptionButton18.Value = False
Else
If TB21.Value = "Non renseigné" Then
OptionButton16.Value = False
OptionButton17.Value = False
OptionButton18.Value = True
End If
End If
End If

If TB22.Value = "Oui" Then
OptionButton19.Value = True
OptionButton20.Value = False
OptionButton21.Value = False
Else
If TB22.Value = "Non" Then
OptionButton19.Value = False
OptionButton20.Value = True
OptionButton21.Value = False
Else
If TB22.Value = "Non renseigné" Then
OptionButton19.Value = False
OptionButton20.Value = False
OptionButton21.Value = True
End If
End If
End If

If TB23.Value = "Oui" Then
OptionButton22.Value = True
OptionButton23.Value = False
OptionButton24.Value = False
Else
If TB23.Value = "Non" Then
OptionButton22.Value = False
OptionButton23.Value = True
OptionButton24.Value = False
Else
If TB23.Value = "Non renseigné" Then
OptionButton22.Value = False
OptionButton23.Value = False
OptionButton24.Value = True
End If
End If
End If

If TB24.Value = "Oui" Then
OptionButton25.Value = True
OptionButton26.Value = False
OptionButton27.Value = False
OptionButton28.Value = False
Else
If TB24.Value = "Non" Then
OptionButton25.Value = False
OptionButton26.Value = True
OptionButton27.Value = False
OptionButton28.Value = False
Else
If TB24.Value = "Antérieur" Then
OptionButton25.Value = False
OptionButton26.Value = False
OptionButton27.Value = True
OptionButton28.Value = False
Else
If TB24.Value = "Non renseigné" Then
OptionButton25.Value = False
OptionButton26.Value = False
OptionButton27.Value = False
OptionButton28.Value = True
End If
End If
End If
End If

If TB25.Value = "Oui" Then
OptionButton29.Value = True
OptionButton30.Value = False
OptionButton31.Value = False
Else
If TB25.Value = "Non" Then
OptionButton29.Value = False
OptionButton30.Value = True
OptionButton31.Value = False
Else
If TB25.Value = "Non renseigné" Then
OptionButton29.Value = False
OptionButton30.Value = False
OptionButton31.Value = True
End If
End If
End If

If TB26.Value = "Oui" Then
OptionButton32.Value = True
OptionButton33.Value = False
OptionButton34.Value = False
Else
If TB26.Value = "Non" Then
OptionButton32.Value = False
OptionButton33.Value = True
OptionButton34.Value = False
Else
If TB26.Value = "Non renseigné" Then
OptionButton32.Value = False
OptionButton33.Value = False
OptionButton34.Value = True
End If
End If
End If

If TB27.Value = "Oui" Then
OptionButton35.Value = True
OptionButton36.Value = False
OptionButton37.Value = False
Else
If TB27.Value = "Non" Then
OptionButton35.Value = False
OptionButton36.Value = True
OptionButton37.Value = False
Else
If TB27.Value = "Non renseigné" Then
OptionButton35.Value = False
OptionButton36.Value = False
OptionButton37.Value = True
End If
End If
End If

If TB28.Value = "Oui" Then
OptionButton38.Value = True
OptionButton39.Value = False
OptionButton40.Value = False
Else
If TB28.Value = "Non" Then
OptionButton38.Value = False
OptionButton39.Value = True
OptionButton40.Value = False
Else
If TB28.Value = "Non renseigné" Then
OptionButton38.Value = False
OptionButton39.Value = False
OptionButton40.Value = True
End If
End If
End If

If TB29.Value = "Vrai nouveau" Then
OptionButton41.Value = True
OptionButton42.Value = False
OptionButton43.Value = False
Else
If TB29.Value = "Vu dans l'année" Then
OptionButton41.Value = False
OptionButton42.Value = True
OptionButton43.Value = False
Else
If TB29.Value = "Pas vu plus d'un an" Then
OptionButton41.Value = False
OptionButton42.Value = False
OptionButton43.Value = True
End If
End If
End If


End Sub

'Correspond au programme du bouton MODIFIER
Private Sub CommandButton2_Click()
If MsgBox("Etes-vous certain de vouloir modifier la fiche patient ?", vbYesNo, "Demande de confirmation") = vbYes Then
Dim Ligne As Long
Dim L As Integer
Dim TB

If Me.ComboBox1.ListIndex = -1 Then Exit Sub
Ligne = Me.ComboBox2.List(Me.ComboBox2.ListIndex, 1)

For L = 1 To 33
If Me.Controls("TB" & L).Visible = True Then
Ws.Cells(Ligne, L + 2) = Me.Controls("TB" & L)
End If
Next L
End If


End Sub

'Programmation de Nettoyage en effaçant les données de toutes les TB
Sub Nettoyage()
Dim I As Integer
Dim TB
For I = 1 To 33
Me.Controls("TB" & I) = ""
Next I
End Sub

Voilà.

 

[Lone-wolf]

Bonjour MOLLE

Reprend le code que tu as mis. Clique sur l'icône à gauche de celui d'enregistrer Code > VB et remet le code, trop long et illisible.

 

[MOLLE]

Re bonjour,

Je reviens sur mon soucis de récupération des bonnes textbox. Après avoir sélectionné le prénom (combobox2) , toutes les texbox du formulaire viennent se remplir. Sauf que ça ne récupère pas les bonnes infos au bon endroit.

Je vous met un bout de code pour voir si vous voyez une erreur :

'Correspond au programme de la LISTE DEROULANTE "NOM"
Private Sub ComboBox1_Change()
Dim J As Long

Nettoyage 'Lance le programme Nettoyage

Me.ComboBox2.Clear 'Efface les données de la combobox2
If Me.ComboBox1.ListIndex = -1 Then Exit Sub
With Me.ComboBox2
For J = 2 To NbLignes
If Ws.Range("A" & J) = Me.ComboBox1 Then
.AddItem Ws.Range("B" & J)
.List(.ListCount - 1, 1) = J
End If
Next J
End With
End Sub

'Correspond à la liste déroulante Prénom
Private Sub ComboBox2_Change()
Dim Ligne As Long
Dim I As Integer
Dim TB
Nettoyage 'Lance le programme Nettoyage
If Me.ComboBox2.ListIndex = -1 Then Exit Sub
Ligne = Me.ComboBox2.List(Me.ComboBox2.ListIndex, 1)
For I = 1 To 33
Me.Controls("TB" & I) = Ws.Cells(Ligne, I + 2)
Next I

Je vous épargne la suite qui récupère les cases à cocher et qui est très long.

Merci