VBA ajouter un sous client à la base de données

Le 17/04/2018 à 12:35

Bonjour, lorsque je rajoute un client à ma base de données, il peut également être associé avec des sous clients (le même numéro mais un sous-numéro différent). Par exemple : pour le client enregistré, une ligne se crée avec toutes les informations remplies dans le formulaire et le n°1 s'affecte dans la colonne Num Client et le sous client est enregistré à la ligne du dessous avec comme Num Client 1.1 avec uniquement les valeurs Nom, Prénom et Date de naissance.

capture frmsaisie capture bdd sous client 
    With Worksheets("Clients").ListObjects(1)

        'si dernière ligne du tableau non vide, ajout d'une ligne
        If .ListColumns("Num Client").DataBodyRange.Rows(.ListRows.Count) <> Empty Then .ListRows.Add
        'incrémentation automatique du numéro de client
        .ListColumns("Num Client").DataBodyRange.Rows(.ListRows.Count) = Application.Max(.ListColumns("Num Client").DataBodyRange) + 1
        'remplissage autres champs
        .ListColumns(2).DataBodyRange.Rows(.ListRows.Count) = txtNom.Text
        .ListColumns(3).DataBodyRange.Rows(.ListRows.Count) = txtPrenom.Text
        .ListColumns(4).DataBodyRange.Rows(.ListRows.Count) = txtDateNaissance.Text
        .ListColumns(5).DataBodyRange.Rows(.ListRows.Count) = cboProfession.Text
        .ListColumns(6).DataBodyRange.Rows(.ListRows.Count) = cboAssuranceHospi.Text
        .ListColumns(7).DataBodyRange.Rows(.ListRows.Count) = Choose(CInt(OptnAcciCorpOui.Value) + 2, "Oui", "Non")
        .ListColumns(8).DataBodyRange.Rows(.ListRows.Count) = txtCapitaux.Text
        .ListColumns(9).DataBodyRange.Rows(.ListRows.Count) = cboNbPersonnesAjouter.Text
        .ListColumns("Date d'enregistrement").DataBodyRange.Rows(.ListRows.Count) = Date

        If cboNbPersonnesAjouter = 1 Then
        .ListColumns("Num Client").DataBodyRange.Rows(.ListRows.Count) = Application.Max(.ListColumns("Num Client").DataBodyRange) + 0.1
        .ListColumns(2).DataBodyRange.Rows(.ListRows.Count) = txtNom1.Text
        .ListColumns(3).DataBodyRange.Rows(.ListRows.Count) = txtPrenom1.Text
        .ListColumns(4).DataBodyRange.Rows(.ListRows.Count) = txtDateNaissance1.Text

        End If

    End With
Le 17/04/2018 à 21:15

Bonsoir,

En supposant que vos sous-clients sont définis avec txtNom1, txtNom2, ...

Essayer ce code :

    With Worksheets("Clients").ListObjects(1)

        'si dernière ligne du tableau non vide, ajout d'une ligne
        If .ListColumns("Num Client").DataBodyRange.Rows(.ListRows.Count) <> Empty Then .ListRows.Add
        'incrémentation automatique du numéro de client
        num_client = Application.Max(.ListColumns("Num Client").DataBodyRange) + 1
        .ListColumns("Num Client").DataBodyRange.Rows(.ListRows.Count) = num_client
        'remplissage autres champs
        .ListColumns(2).DataBodyRange.Rows(.ListRows.Count) = txtNom.Text
        .ListColumns(3).DataBodyRange.Rows(.ListRows.Count) = txtPrenom.Text
        .ListColumns(4).DataBodyRange.Rows(.ListRows.Count) = txtDateNaissance.Text
        .ListColumns(5).DataBodyRange.Rows(.ListRows.Count) = cboProfession.Text
        .ListColumns(6).DataBodyRange.Rows(.ListRows.Count) = cboAssuranceHospi.Text
        .ListColumns(7).DataBodyRange.Rows(.ListRows.Count) = Choose(CInt(OptnAcciCorpOui.Value) + 2, "Oui", "Non")
        .ListColumns(8).DataBodyRange.Rows(.ListRows.Count) = txtCapitaux.Text
        .ListColumns(9).DataBodyRange.Rows(.ListRows.Count) = cboNbPersonnesAjouter.Text
        .ListColumns("Date d'enregistrement").DataBodyRange.Rows(.ListRows.Count) = Date

        For i = 1 To cboNbPersonnesAjouter
            .ListRows.Add
            .ListColumns("Num Client").DataBodyRange.Rows(.ListRows.Count) = Replace(Format(num_client + i / 10, "0.0"), ",", "_")
            .ListColumns(2).DataBodyRange.Rows(.ListRows.Count) = Controls("txtNom" & i).Text
            .ListColumns(3).DataBodyRange.Rows(.ListRows.Count) = Controls("txtPrenom" & i).Text
            .ListColumns(4).DataBodyRange.Rows(.ListRows.Count) = Controls("txtDateNaissance" & i).Text
        Next i

        End If

    End With
Le 17/04/2018 à 22:06
capture suite bdd capture code

Je souhaiterais avoir des points entre les nombres(10.1 10.2 10.3 à la place des underlignes que vous aviez mis) si possible. J'ai tenté de le modifié en vain.

For i = 1 To cboNbPersonnesAjouter
            .ListRows.Add
            .ListColumns("Num Client").DataBodyRange.Rows(.ListRows.Count) = Replace(Format(num_client + i / 10, "0.0"), ".", ".")
            .ListColumns(2).DataBodyRange.Rows(.ListRows.Count) = Controls("txtNom" & i).Text
            .ListColumns(3).DataBodyRange.Rows(.ListRows.Count) = Controls("txtPrenom" & i).Text
            .ListColumns(4).DataBodyRange.Rows(.ListRows.Count) = Controls("txtDateNaissance" & i).Text
        Next i
Le 18/04/2018 à 09:10

Essayer ceci

        For i = 1 To cboNbPersonnesAjouter
            .ListRows.Add
            .ListColumns("Num Client").DataBodyRange.Rows(.ListRows.Count) = num_client & "." & i
            .ListColumns(2).DataBodyRange.Rows(.ListRows.Count) = Controls("txtNom" & i).Text
            .ListColumns(3).DataBodyRange.Rows(.ListRows.Count) = Controls("txtPrenom" & i).Text
            .ListColumns(4).DataBodyRange.Rows(.ListRows.Count) = Controls("txtDateNaissance" & i).Text
        Next i
Le 18/04/2018 à 14:55
capture test bdd 2
Le 18/04/2018 à 20:37

Bonsoir,

ci-jointe correction et ajout de la fonction "Cdate" pour enregistrer les dates au format numérique

    With Worksheets("Clients").ListObjects(1)

        'si dernière ligne du tableau non vide, ajout d'une ligne
        If .ListColumns("Num Client").DataBodyRange.Rows(.ListRows.Count) <> Empty Then .ListRows.Add
        'incrémentation automatique du numéro de client
        num_client = Application.Max(.ListColumns("Num Client").DataBodyRange) + 1
        .ListColumns("Num Client").DataBodyRange.Rows(.ListRows.Count) = num_client
        'remplissage autres champs
        .ListColumns("Nom").DataBodyRange.Rows(.ListRows.Count) = txtNom.Text
        .ListColumns("Prenom").DataBodyRange.Rows(.ListRows.Count) = txtPrenom.Text
        .ListColumns("Date de naissance").DataBodyRange.Rows(.ListRows.Count) = CDate(txtDateNaissance.Text)
        .ListColumns("Profession").DataBodyRange.Rows(.ListRows.Count) = cboProfession.Text
        .ListColumns("Hospitalisation").DataBodyRange.Rows(.ListRows.Count) = cboAssuranceHospi.Text
        .ListColumns("Type Chambre").DataBodyRange.Rows(.ListRows.Count) = cboChambre.Text
        .ListColumns("Accidents Corporels").DataBodyRange.Rows(.ListRows.Count) = Choose(CInt(OptnAcciCorpOui.Value) + 2, "Oui", "Non")
        .ListColumns("Capitaux").DataBodyRange.Rows(.ListRows.Count) = txtCapitaux.Text
        .ListColumns("Nb personne a ajouter").DataBodyRange.Rows(.ListRows.Count) = cboNbPersonnesAjouter.Text
        .ListColumns("Date d'enregistrement").DataBodyRange.Rows(.ListRows.Count) = Date

        For i = 1 To cboNbPersonnesAjouter
            .ListRows.Add
            .ListColumns("Num Client").DataBodyRange.Rows(.ListRows.Count) = "'" & num_client & "." & i
            .ListColumns("Nom").DataBodyRange.Rows(.ListRows.Count) = Controls("txtNom" & i).Text
            .ListColumns("Prenom").DataBodyRange.Rows(.ListRows.Count) = Controls("txtPrenom" & i).Text
            .ListColumns("Date de naissance").DataBodyRange.Rows(.ListRows.Count) = CDate(Controls("txtDateNaissance" & i).Text)
        Next i

    End With
Rechercher des sujets similaires à "vba ajouter client base donnees"