Gestion d'une liste d'individu par formulaire

Bonjour au forum,

J'essaie de mettre en place un fichier me permettant de gérer une liste d'individus (donneurs de sang rare) via un formulaire.

Le principal fonctionne mais je bloque encore sur certains points :

• Lors de l'ajout d'un nouvel individu via le formulaire, reporter le numéro d'individu saisi dans la combox1 dans le tableau de la feuille "Formulaire"
• Lors de l'ajout d'un nouvel individu via le formulaire, la date de dernier don ne s'affiche pas dans le tableau de la feuille "Formulaire" (textbox29)
• lors de la modification de la date de dernier don d'un individu, celle-ci ne se modifie pas dans le tableau de la feuille "Formulaire"
• Ne pas reporter la valeur de la textbox6 (sauter cette colonne) dans le tableau de la feuille "Formulaire" car ces cellules comportent une formule
• Idéalement, avoir une liste déroulante dans la textbox28 "Allèles spéciaux" pour sélectionner plus rapidement des donneurs intéressants.

Je sollicite volontiers votre aide pour finaliser ce beaux petit projet

Nico.

Bonjour,

Suggestions... :

Private Sub ComboBox1_Change()
    Dim I%
    If ComboBox1.ListIndex >= 0 Then
        For I = 3 To 31
            Me.Controls("TextBox" & I - 2) = Sheets("Formulaire").Cells(ComboBox1.ListIndex + 11, I)
        Next
        Me.ComboBox2 = Cells(ComboBox1.ListIndex + 11, 2)
        Me.modifier.Enabled = True: Me.nouveau.Enabled = False
    Else
        For I = 1 To 29
            Me.Controls("TextBox" & I).Value = ""
        Next I
        Me.ComboBox2.Value = ""
        Me.modifier.Enabled = False: Me.nouveau.Enabled = True
    End If
End Sub

Si pas de sélection ou valeur ajoutée manuellement, ListIndex = -1 (permet de distinguer si déjà inscrit ou non)...

Faire en sorte qu'un seul bouton soit actif à la fois : nouveau ou modifier.

Si on a sélectionné, puis qu'on efface Combo1 (ou qu'on modifie avec un numéro non listé), les TextBox doivent être réinitialisés (effacés).

Private Sub nouveau_Click()
    If Me.ComboBox1.Value <> "" Then
        ligne = Sheets("Formulaire").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        enregistrement ligne, True
        MsgBox ("Ajouté !")
    Else
        MsgBox "Saisir le numéro d'individu.", vbInformation, "Saisie manquante"
        Me.ComboBox1.SetFocus
    End If
End Sub

Le bouton étant actif si aucune sélection dans Combo1, vérifier si valeur saisie avant de donner cours à l'inscription.

Sub enregistrement(ligne, Optional Lnew = False)
    Dim CONTct
    With Me
        CONTct = Array(.ComboBox2.Value, .TextBox1.Text, .TextBox2.Text, .TextBox3.Text, _
         .TextBox4.Text, .TextBox5.Text, .TextBox6.Text, .TextBox7.Text, .TextBox8.Text, _
         .TextBox9.Text, .TextBox10.Text, .TextBox11.Text, .TextBox12.Text, .TextBox13.Text, _
         .TextBox14.Text, .TextBox15.Text, .TextBox16.Text, .TextBox17.Text, .TextBox18.Text, _
         .TextBox19.Text, .TextBox20.Text, .TextBox21.Text, .TextBox22.Text, .TextBox23.Text, _
         .TextBox24.Text, .TextBox25.Text, .TextBox26.Text, .TextBox27.Text, .TextBox28.Text, _
         .TextBox29.Text)
    End With
    With Sheets("Formulaire")
        If Lnew Then .Cells(ligne, 1) = Me.ComboBox1.Value
        .Cells(ligne, 2).Resize(, UBound(CONTct) + 1).Value = CONTct
    liste
End Sub

Traitement à partir de la colonne B (avec rectif du dimensionnement de la plage).

Le numéro n'est plus inséré dans le tableau. La valeur de Combo1 est affectée en A si Lnew.

Autres procédures sans changement.

Cordialement.

Bonjour MFerrand,

Comme toujours, tu m'apportes une solution parfaitement claire et fonctionnelle.

Il ne me reste plus qu'un seul problème :

- lors de l'ajout ou la modification d'un individu, le contenu des cellules de la colonne H est effacé, ce que je ne souhaite pas car ces cellules contiennent des formules.

Cela concerne la textbox6, mais si je l’enlève de ce code :

Sub enregistrement(ligne, Optional Lnew = False)
    Dim CONTct
    With Me
        CONTct = Array(.ComboBox2.Value, .TextBox1.Text, .TextBox2.Text, .TextBox3.Text, _
         .TextBox4.Text, .TextBox5.Text,  .TextBox6.Text, .TextBox7.Text, .TextBox8.Text, _
         .TextBox9.Text, .TextBox10.Text, .TextBox11.Text, .TextBox12.Text, .TextBox13.Text, _
         .TextBox14.Text, .TextBox15.Text, .TextBox16.Text, .TextBox17.Text, .TextBox18.Text, _
         .TextBox19.Text, .TextBox20.Text, .TextBox21.Text, .TextBox22.Text, .TextBox23.Text, _
         .TextBox24.Text, .TextBox25.Text, .TextBox26.Text, .TextBox27.Text, .TextBox28.Text, _
         .TextBox29.Text)
    End With
    With Sheets("Formulaire")
        If Lnew Then .Cells(ligne, 1) = Me.ComboBox1.Value
        .Cells(ligne, 2).Resize(, UBound(CONTct) + 1).Value = CONTct
        End With
    liste
End Sub

toutes les valeurs recopiées sont pour le coup décalées.

As-tu une idée de comment contourner ce problème ?

Nico.

Résolu avec ce code, même si ça doit n'être qu'une magouille...

 With Sheets("Formulaire")
    On Error Resume Next
        If Lnew Then .Cells(ligne, 1) = Me.ComboBox1.Value
        .Cells(ligne, 2).Resize(, UBound(CONTct) + 1).Value = CONTct
        On Error GoTo 0
        End With

Nico.

Bonjour,

C'est un défaut de conception d'introduire un champ calculé dans une série modifiable par formulaire...

La solution la plus simple pour ne pas toucher à la structure consiste à supprimer la formule, à calculer la valeur de ce champ lors de la saisie des champs intervenants dans le calcul au niveau du formulaire, à insérer le résultat dans la TextBox correspondante (qui sera verrouillée pour l'utilisateur puisque rien à y saisir).

Pas le temps tout de suite, mais j'y reviendrai plus tard.

Cordialement.

Merci pour cette réponse MFerrand, c'est bien ce que j'imaginais...

Mais retranscrire les formules en code VBA dépasse largement mes compétences !

Bonsoir,

Dans la fenêtre de propriété, pour TextBox6, tu mets la propriété Locked à True.

A priori un certain nombre de TextBox ne peuvent recevoir que la valeur + ou -

J'ai donc mis une procédure de contrôle :

Sub Vérif(tb As Integer)
    If Not Controls("TextBox" & tb).Value Like "[+-]" Then _
     Controls("TextBox" & tb).Value = ""
End Sub

Pour les TextBox1 à 5, l'évènement Change renvoie sur cette procédure avec la commande :

Vérif IndexduTextBox

Pour les autres TextBox dans ce cas, tu peux faire de même pour contrôler la saisie...

Pour les TextBox 2 à 5, programmation de l'évènement AfterUpdate : lance une procédure Phénotype (ci-dessous) :

Sub Phénotype()
    Dim rh$, i%
    If TextBox2.Value <> "" Then
        For i = 2 To 5
            If Controls("TextBox" & i).Value <> "-" Then Exit For
        Next i
        If i > 5 Then
            rh = "Rh null"
        Else
            rh = IIf(TextBox2.Value = "+", "C", "c")
            rh = rh & IIf(TextBox3.Value = "+", "c", "C")
            rh = rh & IIf(TextBox4.Value = "+", "E", "e")
            rh = rh & IIf(TextBox5.Value = "+", "e", "E")
        End If
    Else
        rh = ""
    End If
    TextBox6.Value = rh
End Sub

Elle fait exactement le travail de la formule et refait donc le calcul à chaque changement.

Cordialement.

Stupéfiant.... !

Merci beaucoup MFerrand !

Il ne me reste plus qu'à tester tout ça sur le fichier intégral dès demain

Excellente journée

Bonjour au Forum, MFerrand,

Je reviens juste pour un petit détail concernant ce fichier :

Une partie de la liste des donneurs provient d'une importation d'un fichier .txt.

Saurais-tu comment je pourrais faire pour que les cellules "Phénotype" du tableau et la textbox6 du formulaire se remplissent automatiquement selon les valeurs importées dans les cellules D à G ?

La textbox6 se renseigne bien automatiquement lorsque l'on valide les autres textbox via le formulaire, mais cela implique que pour chaque donneur importé, je dois entrer dans le formulaire pour "valider" une des textbox pour que le Phénotype se remplisse....

Serait-ce possible ?

J'ai essayé de reprendre ton code et de l'adapter dans ThisWorkBook :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim ph$, i%
    If ActiveSheet.Range("D" & i).Value <> "" Then
        For i = 11 To 1000
            If ActiveSheet.Range("D" & i).Value <> "-" Then Exit For
        Next i
        If i > 5 Then
            ph = "Rh null"
        Else
            ph = IIf(ActiveSheet.Range("D" & i).Value = "+", "C", "c")
            ph = ph & IIf(ActiveSheet.Range("E" & i).Value = "+", "c", "C")
            ph = ph & IIf(ActiveSheet.Range("F" & i).Value = "+", "E", "e")
            ph = ph & IIf(ActiveSheet.Range("G" & i).Value = "+", "e", "E")
        End If
    Else
        ph = ""
    End If
    ActiveSheet.Range("D" & i).Value = ph
End Sub

mais ça ne fonctionne pas.

Nico.

Elle ne le fait pas automatiquement ?

Non, je dois rentrer dans l'userform pour faire "TAB" sur une des textbox concernant le phénotype pour que le résultat s'affiche dans la textbox6 et dans le tableau.

Et étant donné qu'une majeure partie des items de la liste sont importés, j'aimerais que cette colonne "Phénotype se renseigne seule, sans avoir à rentrer dans l'userform pour les valider un par un (environ 800 individus )

Bonjour,

Soit le phénotype est renseigné, et auquel cas à la sélection dans Combo1, il s'inscrit dans la TextBox.

Soit il ne l'est pas, les valeurs des TextBox2 à 5 sont alors chargées, et déclenchent la mise à jour de TextBox6, mais laquelle se trouve effacée parce que non renseigné dans la base (6 arrive après 5 !)...

Normalement, cette situation n'est que transitoire, le temps que la régulation se fasse au fil des modifications... Mais tu peux introduire un recalcul d'office dans la procédure ComboBox1_Change.

Après la boucle 3 à 31 qui charge les valeurs de la base, tu inscris : Phénotype

qui exécutera le calcul. Ainsi au chargement dans le formulaire, le phénotype sera toujours calculé.

Attention, s'il ne se trouve pas dans la base, il n'y sera inscrit que lors d'une validation de modif... mais qu'il y soit ou non, il apparaîtra toujours dans le formulaire.

Cordialement.

Bonjour MFerrand, merci de te re-pencher sur mon problème.

Ta solution améliore la chose mais ne résout pas le problème principal, à savoir le calcul immédiat dans les cellules de la colonne "Phénotype Rh" lors de l'importation.

J'ai testé en remettant la formule initiale dans ces cellules, que tu as superbement adapté en code VBA, mais évidemment, lors de l'importation, la formule est écrasée

Une solution serait de "sauter" cette colonne "Phénotype Rh" lors de l'importation d'un .txt, mais je n'ai rien trouvé à ce sujet, mis à part

Array(8, 10)

et

Array(8, xlskipcolumn)

qui ne fonctionnent pas.

Mais c'est peut-être tout simplement impossible, j'imagine qu'Excel a ses limites aussi !

En fait le problème ne se pose que si le phénotype est absent de l'importation...

Sans bouleverser la conception de ton fichier, tu peux avoir une procédure à lancer après import qui remplit ce champ. Tout le reste sera fonctionnel...

Cordialement.

Bonjour MFerrand,

Effectivement, une procédure à part est une bonne idée.

J'ai écris ce code :

Private Sub CommandButton1_Click()

Nb_colonne = 4
Nb_ligne = 1000

For Each c In Range("D11:D" & Nb_ligne)
concat = c.Value
For i = 1 To Nb_colonne
concat = concat & c.Offset(0, i)
Next
ligne = c.Row
Range("H" & ligne).Value = concat
Next

End Sub

Cela fonctionne bien, le résultat en colonne "G" s'affiche comme ceci par exemple : "+-+-"

J'aimerais pouvoir transcrire ces résultats de cette manière :

Si "++++" = "CcEe"

Si "----" = "Rh Null"

Si "+-+-" = "CCEE"

Si "+--+" = "CCee"

Si "+-++" = "CCEe"

Si "-+-+" = "ccee"

Si "-+++" = "ccEe"

Si "-++-" = "ccEE"

Si "+++-" = "CcEE"

Si "++-+" = "Ccee"

Une idée... ?

J'ai trouvé la solution pour ceux que ça intéresse :

Private Sub CommandButton4_Click()

Nb_colonne = 4
Nb_ligne = 1000

For Each c In Range("D11:D" & Nb_ligne)
concat = c.Value
For i = 1 To Nb_colonne
concat = concat & c.Offset(0, i)
Next
ligne = c.Row
Range("H" & ligne).Value = concat

If Range("H" & ligne).Value = "++++" Then
        Range("H" & ligne).Value = "CcEe"
ElseIf Range("H" & ligne).Value = "----" Then
        Range("H" & ligne).Value = "Rh Null"
ElseIf Range("H" & ligne).Value = "+-+-" Then
        Range("H" & ligne).Value = "CCEE"
ElseIf Range("H" & ligne).Value = "+--+" Then
        Range("H" & ligne).Value = "CCee"
ElseIf Range("H" & ligne).Value = "+-++" Then
        Range("H" & ligne).Value = "CCEe"
ElseIf Range("H" & ligne).Value = "-+-+" Then
        Range("H" & ligne).Value = "ccee"
ElseIf Range("H" & ligne).Value = "-+++" Then
        Range("H" & ligne).Value = "ccEe"
ElseIf Range("H" & ligne).Value = "-++-" Then
        Range("H" & ligne).Value = "ccEE"
ElseIf Range("H" & ligne).Value = "+++-" Then
        Range("H" & ligne).Value = "CcEE"
ElseIf Range("H" & ligne).Value = "++-+" Then
        Range("H" & ligne).Value = "Ccee"
ElseIf Range("H" & ligne).Value = "" Then
        Range("H" & ligne).Value = ""

Else
        Exit Sub

End If

Next
End Sub

Merci encore pour ton aide MFerrand !

C'est quoi ce code !

Pas indenté ! Aucune variable déclarée ! Des actions inutiles ! Et ta formule initiale non respectée !

Sub CalculPhénotype()
    Dim phnt$, Ln%, i%, k%
    With ActiveSheet
        Ln = .Cells(.Rows.Count, 1).End(xlUp).Row
        Application.ScreenUpdating = False
        For i = 11 To Ln
            phnt = ""
            If .Cells(i, 4) <> "" Then
                For k = 4 To 6 Step 2
                    phnt = phnt & Chr(k + IIf(.Cells(i, k) = "+", 63, 95))
                    phnt = phnt & Chr(k + IIf(.Cells(i, k + 1) = "+", 95, 63))
                Next k
                If phnt = "ccee" Then phnt = "Rh null"
            End If
            .Cells(i, 8) = phnt
        Next i
    End With
End Sub

A rattacher à un bouton sur la feuille Formulaire.

Mais ce n'est qu'un pis-aller ! Car cet ajustement ne devrait concerner que le lot d'individus inséré. Il serait donc plus efficace de coupler cet ajustement à l'insertion (selon méthode d'insertion utilisée...)

Cordialement.

Ouf !

J'en prends pour mon grade là !

Mais c'est mérité, j'en conviens...

En réalité la vraie façon de gérer ce calcul de phénotype est celui-ci :

Si "++++" = "CcEe"

Si "----" = "Rh Null"

Si "+-+-" = "CCEE"

Si "+--+" = "CCee"

Si "+-++" = "CCEe"

Si "-+-+" = "ccee"

Si "-+++" = "ccEe"

Si "-++-" = "ccEE"

Si "+++-" = "CcEE"

Si "++-+" = "Ccee"

mais j'ai fais comme j'ai pu avec la formule

Ton code est beaucoup plus clair, c'est une évidence, mais je ne suis pas capable de tout le comprendre (et du coup il n'est pas adapté à la "vraie" façon de calculer le phénotype)...

Si tu as le temps, je prendrais volontiers tes explications, c'est un plaisir d'apprendre !

Nico.

Il y a deux choses, le code et son écriture d'un côté, le comment on doit calculer de l'autre ?

Laissons pour l'instant la première de côté. En ce qui concerne la seconde, je n'ai pas de connaissance préalable et me suis donc exclusivement basé sur ta formule initiale qui le calculait dans la colonne H.

Or ta formule opérait ainsi, sachant que chacun des 4 éléments ( C c E e ) peut prendre deux valeurs : + ou -, mais que le test porte simultanément sur une 3e valeur que je noterai "" [signifiant que la valeur de l'élément ne figure pas !]

Si C = "" => ""

Sinon Si C = - ET c = - ET E = - ET e = - => Rh null

Sinon

Si C = + => C Sinon (si C = - ) => c

à concaténer avec :

Si c = + => c Sinon (si c = - OU c = "") => C

à concaténer avec :

Si E = + => E Sinon (si E = - OU E = "") => e

à concaténer avec :

Si e = + => e Sinon (si e = - OU e ="" ) => E

Si cette façon de calculer n'est pas exacte, c'est que ta formule initiale ne pouvait fournir le résultat exact, d'autant plus que ce que j'ai transcrit ci-dessus en : - OU "" était de fait dans la formule : <>+ (soit pouvant couvrir toute autre valeur que +). Le problème était limité du moins au niveau du formulaire en limitant les valeurs acceptées par les TextBox à + ou -.

Il convient donc de commencer par la définition des modalités de calcul de façon exhaustive, en n'omettant jamais le cas : Autre (tout ce qui n'a pas été énuméré avant), cas qui boucle la totalité des cas possibles.

Cordialement.

Bonjour MFerrand,

Ma formule initiale n'était effectivement pas idéale, mais j'ai essayé de l'adapter au mieux pour que le calcul fonctionne dans la plupart des cas...

Je vais donc détailler la manière optimale dont le calcul devrait être fait, en essayant d'être le plus précis possible :

Ces 5 lettres D C c E e correspondent à ce qu'on appelle des antigènes, qui sont des molécules, présentes ou non (d'où le + ou -), à la surface des globules rouges et qui définissent ce qu'on appelle le phénotype rhésus.

Les GR (globules rouges ou hématies) ne possédant pas l'antigène C sont nécessairement c positives (et inversement, un c négatif est forcément C positif, sauf rares exceptions expliquées ci-dessous), il en est de même pour les antigènes E et e, les hématies négatives pour l’antigène E étant nécessairement positives pour l’antigène e (et inversement). C’est ce que l’on appelle la règle de l’antithétisme. Bien évidemment on peut observer des hématies possédant à la fois les antigènes « antithétiques » C et c, E et e.

L'antigène D est quant à lui "seul", et n'a d’intérêt pour mon fichier que dans les deux exceptions suivantes :

La première des rares exceptions qui m’intéressent pour ce fichier est ce qu'on appelle le Rh Null, qui signifie que le sujet a une absence totale de tous ces antigènes rhésus, il sera donc D- C- c- E- e-.

La seconde des rares exceptions qui m’intéressent pour ce fichier est ce qu'on appelle le Rh D-- (dont je n'ai pas encore parlé jusqu'à aujourd'hui), qui signifie que le sujet a une absence totale de tous ces antigènes rhésus, sauf de l’antigène D : il sera donc D+ C- c- E- e-.

Les autres cas, plus ou moins courant, sont ceux cités dans mon précédent message, soit :

Si "C+c+E+e+" = "CcEe"

Si "C+c-E+e-" = "CCEE"

Si "C+c-E-e+" = "CCee"

Si "C+c-E+e+" = "CCEe"

Si "C-c+E-e+" = "ccee"

Si "C-c+E+e+" = "ccEe"

Si "C-c+E+e-" = "ccEE"

Si "C+c+E+e-" = "CcEE"

Si "C+c+E-e+" = "Ccee"

J’espère avoir été suffisamment clair et précis !