Un frm qui liste les informations sur 3 choix en cbo

Le 07/07/2021 à 14:40
frminfo 
Private Sub btnQuitter_Click()
    'Retour dans le Tableau de bord
        Sheets("Accueil").Activate
        Range("A1").Activate
        Unload Me
End Sub

Private Sub cboRefPatiente_AfterUpdate()

On Error GoTo 1

    If WorksheetFunction.CountIf(Sheets("Patiente").Range("A:A"), Me.cboRefPatiente.Value) = 0 Then

        MsgBox "Cette patiente n'éxiste pas. Veuillez resaisir un nouveau client", vbInformation + vbOKOnly, "Client non trouvé"

    End If

    With Me

    'Patiente
    txtNom = Application.WorksheetFunction.VLookup(Me.cboRefPatiente, Sheets("Patiente").Range("BDPatiente"), 2, 0)
    txtPrenom = Application.WorksheetFunction.VLookup(Me.cboRefPatiente, Sheets("Patiente").Range("BDPatiente"), 3, 0)
    txtDNaisPat = Application.WorksheetFunction.VLookup(Me.cboRefPatiente, Sheets("Patiente").Range("BDPatiente"), 4, 0)
    txtDNaisPat = Format(txtDNaisPat, "dd/mm/yyyy")
    'txtAge = Application.WorksheetFunction.VLookup(Me.cboRefPatiente, Sheets("Patiente").Range("BDPatiente"), 5, 0)
    txtAdresse = Application.WorksheetFunction.VLookup(Me.cboRefPatiente, Sheets("Patiente").Range("BDPatiente"), 6, 0)
    txtCP = Application.WorksheetFunction.VLookup(Me.cboRefPatiente, Sheets("Patiente").Range("BDPatiente"), 7, 0)
    txtVille = Application.WorksheetFunction.VLookup(Me.cboRefPatiente, Sheets("Patiente").Range("BDPatiente"), 8, 0)
    txtTelMob = Application.WorksheetFunction.VLookup(Me.cboRefPatiente, Sheets("Patiente").Range("BDPatiente"), 9, 0)
    txtTelMob = Format(txtTelMob, "0# ## ## ## ##")
    txtAutre = Application.WorksheetFunction.VLookup(Me.cboRefPatiente, Sheets("Patiente").Range("BDPatiente"), 10, 0)
    txtAutre = Format(txtAutre, "0# ## ## ## ##")
    txtTelDom = Application.WorksheetFunction.VLookup(Me.cboRefPatiente, Sheets("Patiente").Range("BDPatiente"), 11, 0)
    txtTelDom = Format(txtTelDom, "0# ## ## ## ##")
    txtMail = Application.WorksheetFunction.VLookup(Me.cboRefPatiente, Sheets("Patiente").Range("BDPatiente"), 12, 0)
    txtNGros = Application.WorksheetFunction.VLookup(Me.cboRefPatiente, Sheets("Patiente").Range("BDPatiente"), 13, 0)
    txtFausCou = Application.WorksheetFunction.VLookup(Me.cboRefPatiente, Sheets("Patiente").Range("BDPatiente"), 14, 0)
    txtAllait = Application.WorksheetFunction.VLookup(Me.cboRefPatiente, Sheets("Patiente").Range("BDPatiente"), 15, 0)
    txtMedecin = Application.WorksheetFunction.VLookup(Me.cboRefPatiente, Sheets("Patiente").Range("BDPatiente"), 16, 0)
    txtMater = Application.WorksheetFunction.VLookup(Me.cboRefPatiente, Sheets("Patiente").Range("BDPatiente"), 17, 0)
    txtConCom = Application.WorksheetFunction.VLookup(Me.cboRefPatiente, Sheets("Patiente").Range("BDPatiente"), 18, 0)
    txtAntec = Application.WorksheetFunction.VLookup(Me.cboRefPatiente, Sheets("Patiente").Range("BDPatiente"), 19, 0)
    txtNotes = Application.WorksheetFunction.VLookup(Me.cboRefPatiente, Sheets("Patiente").Range("BDPatiente"), 20, 0)
    'txtJenreg = Application.WorksheetFunction.VLookup(Me.cboRefPatiente, Sheets("Patiente").Range("BDPatiente"), 21, 0)

    'Bébé
    txtNombebe = Application.WorksheetFunction.VLookup(Me.cboRefBebe, Sheets("Bebe").Range("BDBebe"), -2, 0)
    txtPrenombebe = Application.WorksheetFunction.VLookup(Me.cboRefBebe, Sheets("Bebe").Range("BDBebe"), -1, 0)
    txtDNaisbebe = Application.WorksheetFunction.VLookup(Me.cboRefBebe, Sheets("Bebe").Range("BDBebe"), 6, 0)
    txtDNaisbebe = Format(TextBox3, "dd/mm/yyyy")
    TextBox4 = Application.WorksheetFunction.VLookup(Me.cboRefBebe, Sheets("Bebe").Range("BDBebe"), 7, 0)
    TextBox4 = Format(TextBox4, "dd/mm/yyyy")
    TextBox5 = Application.WorksheetFunction.VLookup(Me.cboRefBebe, Sheets("Bebe").Range("BDBebe"), 8, 0)
    TextBox6 = Application.WorksheetFunction.VLookup(Me.cboRefBebe, Sheets("Bebe").Range("BDBebe"), 5, 0)
    TextBox7 = Application.WorksheetFunction.VLookup(Me.cboRefBebe, Sheets("Bebe").Range("BDBebe"), 9, 0)
    TextBox8 = Application.WorksheetFunction.VLookup(Me.cboRefBebe, Sheets("Bebe").Range("BDBebe"), 10, 0)

    'Rendez-vous
    txtDRdV = Application.WorksheetFunction.VLookup(Me.cboDRdV, Sheets("RdV").Range("BDRdV"), 3, 0)
    txtDRdV = Format(txtDRdV, "dd/mm/yyyy")
    txtHRdV = Application.WorksheetFunction.VLookup(Me.cboDRdV, Sheets("RdV").Range("BDRdV"), 4, 0)
    txtHRdV = Format(txtHRdV, "hh:mm")
    txtLieu = Application.WorksheetFunction.VLookup(Me.cboDRdV, Sheets("RdV").Range("BDRdV"), 5, 0)
    txtMode = Application.WorksheetFunction.VLookup(Me.cboDRdV, Sheets("RdV").Range("BDRdV"), 6, 0)
    txtMontant = Application.WorksheetFunction.VLookup(Me.cboDRdV, Sheets("RdV").Range("BDRdV"), 8, 0)
    txtMontant = Format(txtMontant, "Currency")
    txtCR = Application.WorksheetFunction.VLookup(Me.cboDRdV, Sheets("RdV").Range("BDRdV"), 15, 0)
    txtFiche = Application.WorksheetFunction.VLookup(Me.cboDRdV, Sheets("RdV").Range("BDRdV"), 16, 0)
    txtStatut = Application.WorksheetFunction.VLookup(Me.cboDRdV, Sheets("RdV").Range("BDRdV"), 17, 0)
    txtResume = Application.WorksheetFunction.VLookup(Me.cboDRdV, Sheets("RdV").Range("BDRdV"), 18, 0)

    End With
1
End Sub

'Gestion du choix de la mamam
Private Sub cboRefPatiente_Change()
Dim Cel As Range
cboRefBebe.Clear
For Each Cel In Worksheets("Bebe").ListObjects("TBebe").ListColumns(4).DataBodyRange
    If Cel.Offset(0, -3) = cboRefPatiente.Value Then cboRefBebe.AddItem Cel.Value
Next Cel
Dim Cel1 As Range
cboDRdV.Clear
For Each Cel1 In Worksheets("RdV").ListObjects("TRDV").ListColumns(3).DataBodyRange
    If Cel1.Offset(0, -2) = cboRefPatiente.Value Then cboDRdV.AddItem Cel1.Value
Next Cel1
End Sub

Private Sub UserForm_Initialize()
Dim tablo As Collection
Dim C As Range
Dim Item
Set tablo = New Collection
On Error Resume Next
With Worksheets("Patiente")
    For Each C In .ListObjects("TPatientel").ListColumns(1).DataBodyRange
        tablo.Add C.Value, CStr(C.Value)
    Next C
    On Error GoTo 0
    For Each Item In tablo
        Me.cboRefPatiente.AddItem Item
    Next
End With
End Sub

Bonjour,

J'ai adapté les codes de Dan dans un autre problème. Mais... (je ne suis pas doué). Mon appli bug.

Voici l'idée. Un formulaire reprenant les infos dans 3 onglets après des choix en cascade. 1 cboRefPatiente qui déclenche la liste des bebe cboRefbebe qui lui-même déclenche la liste des dates de RdV cboDRdV.

Cela devrait donner les infos de la maman, les infos du bébé et les infos lors du rendez-vous sélectionné.

Les choix se font bien, Vlookup de la maman donne bien les bons résultats et ensuite bug. Il n'affiche plus rien et se bloque sur End Sub

Où j'ai commis une ou des erreurs ? Merci de votre aide et votre œil perspicace.

Le 07/07/2021 à 14:50

Bonjour

Les choix se font bien, Vlookup de la maman donne bien les bons résultats et ensuite bug. Il n'affiche plus rien et se bloque sur End Sub

Je vous l'ai déjà dit dans l'autre fil. Vous postez tous les codes donc on ne sait pas comprendre. Pourquoi ?
Si cela bloque sur le END SUB, la ligne est soulignée en jaune. Dans quel code ? Dans le code Private Sub cboRefPatiente_AfterUpdate() ?
Si je choisis dans la liste cbopatiente, je n'ai aucune erreur.

Le 07/07/2021 à 15:09

Private Sub cboRefPatiente_AfterUpdate()

Il affiche 'Patiente puis passe à End Sub sans autre affichage

End Sub

Il ne prend pas en compte cboRefBebe, ni cboDRdV dans VLookUp

Le 07/07/2021 à 15:16

Il ne prend pas en compte cboRefBebe, ni cboDRdV dans VLookUp

Logique, il n'y a pas de combobox cborefbebe ni de combobox cboDRrdv dans votre userform.
Dans la version 2 que j'ai posté dans l'autre fil, cela fonctionne bien je pense

Le 07/07/2021 à 15:38

Oui tout fonctionne dans ce que vous m'avez donné et j'ai voulu affiner la recherche d'infos avec les choix.

Dans Userform (voir photo), il y a une cboRefBébé dans la selection en vert et une cboDRdV dans la selection en jaune. Pour le bleu tout est OK.

Cet Userform est différent de celui que vous m'avez aidé, il regroupe le fichier Patient, le fichier Bebe et le fichier RdV. Car j'ai eu le cas d'une maman avec 2 bébés dont le second à lui 3 rendez-vous de suivi. La lecture originale donnait la maman avec le premier bebe rencontré et le premier rendez-vous rencontré. Là je voudrais selectionnré le "bon" bébé et le bon "rdv" pour revoir mes notes et informations avant une nouvelle consultation.

Le 08/07/2021 à 09:34

Bonjour,

Voici déjà une partie avec deux codes à placer dans l'userform frmInfoPatiente :

Etape 1: remplacez votre code Afterupdate par la macro ci-dessous

Private Sub cboRefPatiente_change()
Dim lig As Integer
Dim cel As Range

Me.cboRefBebe.Clear
For Each cel In Worksheets("Bebe").ListObjects("TBebe").ListColumns(4).DataBodyRange
    If cel.Offset(0, -3) = Me.cboRefPatiente.Value Then Me.cboRefBebe.AddItem cel.Value
Next cel

With Sheets("Patiente").ListObjects("TPatientel")
    lig = .ListColumns(1).DataBodyRange.Find(cboRefPatiente, LookIn:=xlValues, lookat:=xlWhole).Row - 1
    With .DataBodyRange
        txtNom = .Item(lig, 2).Value
        txtPrenom = .Item(lig, 3).Value
        txtDNaisPat = Format(.Item(lig, 4).Value, "dd/mm/yyyy")
        txtAdresse = .Item(lig, 6).Value
        txtCP = .Item(lig, 7).Value
        txtVille = .Item(lig, 8).Value
        txtTelMob = Format(.Item(lig, 9).Value, "0# ## ## ## ##")
        txtTelDom = Format(.Item(lig, 10).Value, "0# ## ## ## ##")
        txtAutre = Format(.Item(lig, 11).Value, "0# ## ## ## ##")
        txtMail = .Item(lig, 12).Value
        txtNGros = .Item(lig, 13).Value
        txtFausCou = .Item(lig, 14).Value
        txtAllait = .Item(lig, 15).Value
        txtMedecin = .Item(lig, 16).Value
        txtMater = .Item(lig, 17).Value
        txtConCom = .Item(lig, 18).Value
        txtAntec = .Item(lig, 19).Value
        txtNotes = .Item(lig, 20).Value
    End With
End With
End Sub

Etape 2 : ajoutez ce code

Private Sub cboRefBebe_Change()
Dim lig As Integer

Me.cboDRdV.Clear
With Worksheets("Bebe").ListObjects("TBebe")
    lig = .ListColumns(4).DataBodyRange.Find(cboRefBebe, LookIn:=xlValues, lookat:=xlWhole).Row - 1
    With .DataBodyRange
        Me.TextBox1 = .Item(lig, 2).Value 'Nom
        Me.TextBox2 = .Item(lig, 3).Value 'Prenom
        Me.TextBox3 = Format(.Item(lig, 6).Value, "dd/mm/yyyy") 'Date naissance
        Me.TextBox4 = Format(.Item(lig, 7).Value, "dd/mm/yyyy") 'Date terme
        Me.TextBox5 = .Item(lig, 8).Value 'Poids
        Me.TextBox6 = .Item(lig, 5).Value 'Pediatre
        Me.TextBox7 = .Item(lig, 9).Value 'Projet allaitement
        Me.TextBox8 = .Item(lig, 10).Value 'Information
    End With
End WithIn Worksheets("Rdv").ListObjects("TRdv").ListColumns(1).DataBodyRange
    If cel = Me.cboRefPatiente.Value And cel.Offset(0, 1) = Me.cboRefBebe.Value Then Me.cboDRdV.AddItem cel.Offset(0, 2).Value
Next cel
End Sub

Je reviens vers vous pour la suite --> Encart Jaune Rendez-vous

Le 08/07/2021 à 10:09

Bonjour,

D'abord merci pour votre aide, je recopie et décortique pour comprendre mais

J'ai ajouté le 2eme code et j'ai le ligne END WithIn .... en rouge avec un code erreur voir photo jointe

capture1
Le 08/07/2021 à 10:12

Dois-je effacer aussi les code à partir de

'Gestion du choix de la maman

Car il indique nom Ambigu le code a le même nom que celui que vous m'avez envoyé

Le 08/07/2021 à 10:36

J'ai gardé et ajouté les codes suivants :

Private Sub UserForm_Initialize()

Private Sub cboRefPatiente_change()

Private Sub cboRefBebe_Change()

cela fonctionne jusqu'au rdv. Pour cela j'ai modifié cette ligne (bien sur bug dessus mais normal vous y travaillez)For Each cel In Worksheets("RdV").ListObjects("TRDV").ListColumns(1).DataBodyRange
If cel = Me.cboRefPatiente.Value And cel.Offset(0, 1) = Me.cboRefBebe.Value Then Me.cboDRdV.AddItem cel.Offset(0, 2).Value
Next cel

Le 08/07/2021 à 10:49

Pour le bug, c'est vous qui avez mal recopié. Vous aviez deux end sub probablement dans une des codes

cela fonctionne jusqu'au rdv. Pour cela j'ai modifié cette ligne

Ben elle est dans le code que je vous ai proposé. Mais je vois que j'ai mal collé le code. Remplacez le par celui ci-dessous dans lequel j'ai rajouté deux lignes pour gérer l'erreur si la variable Lig n'est pas trouvée et une boucle pour effacer les textbox si changement de nom dans cborefpatiente

Private Sub cboRefBebe_Change()
Dim lig As Integer
Dim i As Byte

Me.cboDRdV.Clear
For i = 1 To 8
    Me.Controls("Textbox" & i) = "" 'Effacer les textbox
Next i

With Worksheets("Bebe").ListObjects("TBebe")
    On Error Resume Next
    lig = .ListColumns(4).DataBodyRange.Find(cboRefBebe, LookIn:=xlValues, lookat:=xlWhole).Row - 1
    If lig = 0 Then exit sub
        With .DataBodyRange
            Me.TextBox1 = .Item(lig, 2).Value 'Nom
            Me.TextBox2 = .Item(lig, 3).Value 'Prenom
            Me.TextBox3 = Format(.Item(lig, 6).Value, "dd/mm/yyyy") 'Date naissance
            Me.TextBox4 = Format(.Item(lig, 7).Value, "dd/mm/yyyy") 'Date terme
            Me.TextBox5 = .Item(lig, 8).Value 'Poids
            Me.TextBox6 = .Item(lig, 5).Value 'Pediatre
            Me.TextBox7 = .Item(lig, 9).Value 'Projet allaitement
            Me.TextBox8 = .Item(lig, 10).Value 'Information
        End With
    'End If
End With

Dim cel As Range

For Each cel In Worksheets("Rdv").ListObjects("TRdv").ListColumns(1).DataBodyRange
    If cel = Me.cboRefPatiente.Value And cel.Offset(0, 1) = Me.cboRefBebe.Value And Cel.Offset(0, 2) <> "" Then Me.cboDRdV.AddItem cel.Offset(0, 2).Value
Next cel
End Sub

Normalement avec ce code, si vous avez une date de rendez-vous prévue, elle devrait s'afficher dans la cboDrdv dans l'encart Jaune

Le 08/07/2021 à 11:13

Oui c'est ok . J'ai bien les choix des date de RdV et patiente et bebe s'affiche bien.

Le 08/07/2021 à 11:28

OK

Voici le dernier code à ajouter dans cette userform, pour reprendre les données suivant le choix du rendez vous

Private Sub cboDRdV_Change()
Dim Lig As Integer
Dim Cel As Range

For Each Cel In Worksheets("Rdv").ListObjects("TRdv").ListColumns(1).DataBodyRange
    If Cel = Me.cboRefPatiente.Value And Cel.Offset(0, 1) = Me.cboRefBebe.Value And Cel.Offset(0, 2) = CDate(Me.cboDRdV.Value) Then Lig = Cel.Row - 1: Exit For
Next Cel

With Worksheets("Rdv").ListObjects("TRdv").DataBodyRange
    txtHRdV = Format(.Item(Lig, 4).Value, "HH:MM")
    txtLieu = .Item(Lig, 5).Value
    txtMode = .Item(Lig, 6).Value
    txtMontant = Format(.Item(Lig, 8).Value, "Currency")
    txtCR = .Item(Lig, 15).Value
    txtFiche = .Item(Lig, 16).Value
    txtStatut = .Item(Lig, 17).Value
    txtResume = .Item(Lig, 18).Value
End With
End Sub

Voyez si vous n'avez pas d'erreur à l'utilisation

Dans le code CboRefBebe que j'ai posté avant (--> https://forum.excel-pratique.com/s/goto/988517), j'ai ajouté une instruction dans les lignes juste en dessous de Dim as range. Reprenez ce code là

Le 08/07/2021 à 11:39

If Cel = Me.cboRefPatiente.Value And Cel.Offset(0, 1) = Me.cboRefBebe.Value And Cel.Offset(0, 2) = CDate(Me.cboDRdV.Value) Then Lig = Cel.Row - 1: Exit For

Bug

capture2
Le 08/07/2021 à 13:06

Pas facile, jJe n'ai pas votre vrai fichier

Quelles sont les données que vous avez dans cborefpatiente, cborefbebe et cbodrdv ?

Le 08/07/2021 à 13:38

Je vous est fait un classeur alléger

avec un exemple sans données importante.

Désolé de répondre si tard mais je suis allé me faire faire ma seconde injection covid

Edit Dan : fichier supprimé en accord avec Ghilou14 --> https://forum.excel-pratique.com/s/goto/988664

Le 08/07/2021 à 13:56

J'ai tout vérifier, il y avait des données refbebe avec #N/A et des date vide peut-être mal effacé.

Nouvelle essai et cela fonctionne. Vous etes un AS. Je relis pour bien comprendre et je crois que je vais pouvoir bien travailler avec une superbe application .
Merci encore et bravo

Le 08/07/2021 à 15:26

J'ai tout vérifier, il y avait des données refbebe avec #N/A et des date vide peut-être mal effacé.

Oui j'ai rencontré ce souci aussi dans une version précédente de votre fichier. Peut être aurez vous encore quelques soucis car faire un code c'est surtout penser à la gestion des erreurs..
Donc n'hésitez pas si besoin.

J'ai repris votre dernier fichier. Vous pouvez le supprimer du post car il ne servira plus.

Sinon c'est un beau fichier que vous avez réalisé et bien pensé je trouve.

Cordialement

Le 08/07/2021 à 15:31

Merci du compliment et encore un grand merci à vous, j'ai pu progresser et obtenir ce que je voulais. C'est vraiment super.

Le 08/07/2021 à 15:33

Comment supprimer un fichier d'un post ?

Le 08/07/2021 à 15:46

Comment supprimer un fichier d'un post ?

Vous retournez dans le post, puis vous sélectionnez le petit crayon dans le menu du post (juste à droite de l'étoile)
Ensuite vous cliquez sur le fichier puis touche DELETE sur votre clavier.
Il vous reste à cliquer sur ENVOYER pour mettre le post à jour

Si vous n'y arrivez pas, en tant que modérateur je peux aussi le faire

Rechercher des sujets similaires à "frm qui liste informations choix cbo"