VBA probleme affichage et date

Le 12/04/2018 à 00:22

Bonsoir,

Je voudrais que lorsqu'on clique sur mon bouton "btnAjouter" (qui permet d'ajouter un client à ma bdd), il affiche le msg d'erreur si tout n'est pas complet mais qu'il ne me rempli pas un nouvel enregistrement dans ma bdd sans avoir toutes les informations.

Et 2ème problème, pour les 1ers enregistrement il me mets la date sur une ligne et la suivante. Je ne sais pas pourquoi.

'Procédure permettant d'ajouter un nouveau client dans la base de données
Private Sub btnAjouter_Click()
    'On teste la saisie des champs dans le formulaire
    If Len(Me.txtNom) = 0 Then
        lblMessage = "Veuillez saisir le nom du client"
        'MsgBox "Veuillez saisir le nom du client"
        Me.txtNom.SetFocus
    ElseIf Len(Me.txtPrenom) = 0 Then
        lblMessage = "Veuillez saisir le prénom du client"
        Me.txtPrenom.SetFocus
    ElseIf Len(Me.txtDateNaissance) = 0 Then
        lblMessage = "Veuillez saisir la date de naissance du client"
        Me.txtDateNaissance.SetFocus
    ElseIf Len(Me.cboProfession) = 0 Then
        lblMessage = "Veuillez sélectionner la profession du client"
        Me.cboProfession.SetFocus
    ElseIf Len(Me.cboPaiement) = 0 Then
        lblMessage = "Veuillez sélectionner la fréquence de paiement"
        Me.cboPaiement.SetFocus
    ElseIf Len(Me.txtNbPersonne) = 0 Then
        lblMessage = "Veuillez saisir le nombre de personne à assurer auprès du client"
        Me.txtNbPersonne.SetFocus
    ElseIf (Me.OptnAcciCorpNon) = False And (Me.OptnAcciCorpOui) = False Then
        lblMessage = "Veuillez choisir si le client prend une assurance d'accidents corporels du client"
        Me.txtPrenom.SetFocus
    Else
        lblMessage = ""
    End If

    Sheets("Clients").Activate
    Range("A1").Select
    Selection.End(xlDown).Select 'On se positionne sur la dernière ligne non vide
    Selection.Offset(1, 1).Select 'On se décale d'une ligne vers le bas
    ActiveCell = txtNom.Value
    ActiveCell.Offset(0, 1).Value = txtPrenom
    ActiveCell.Offset(0, 2).Value = txtDateNaissance
    ActiveCell.Offset(0, 3).Value = cboProfession
    ActiveCell.Offset(0, 4).Value = cboAssuranceHospi
    If (Me.OptnAcciCorpOui) = True Then
        ActiveCell.Offset(0, 5).Value = "Oui"
    Else
        ActiveCell.Offset(0, 5).Value = "Non"
    End If
    ActiveCell.Offset(0, 6).Value = txtCapitaux
    ActiveCell.Offset(0, 7).Value = txtNbPersonne

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

        If .ListColumns("Date d'enregistrement").DataBodyRange.Rows(.ListRows.Count) <> Empty Then .ListRows.Add
        .ListColumns("Date d'enregistrement").DataBodyRange.Rows(.ListRows.Count) = "=TODAY()"

    End With

End Sub
Le 12/04/2018 à 06:50

Bonjour,

Une piste (sans voir de fichier exemple) :

Private Sub btnAjouter_Click()

    'message et sortie de procédure pour chaque test
    If txtNom = "" Then MsgBox "Veuillez saisir le nom du client": txtNom.SetFocus: Exit Sub

    If txtPrenom = "" Then MsgBox "Veuillez saisir le prénom du client": txtPrenom.SetFocus: Exit Sub

    If txtDateNaissance = "" Then MsgBox "Veuillez saisir la date de naissance du client": txtDateNaissance.SetFocus: Exit Sub

    If cboProfession = "" Then MsgBox "Veuillez sélectionner la profession du client": cboProfession.SetFocus: Exit Sub

    If cboPaiement = "" Then MsgBox "Veuillez sélectionner la fréquence de paiement": cboPaiement.SetFocus: Exit Sub

    If txtNbPersonne = "" Then MsgBox "Veuillez saisir le nombre de personne à assurer auprès du client": txtNbPersonne.SetFocus: Exit Sub

    If OptnAcciCorpNon = False And OptnAcciCorpOui = False Then MsgBox "Veuillez choisir si le client prend une assurance d'accidents corporels du client": Exit Sub

    With Worksheets("Clients")

        lig = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 'sur colonne A

        .Cells(lig, 1).Value = txtNom.Text
        .Cells(lig, 2).Value = txtPrenom.Text
        .Cells(lig, 3).Value = txtDateNaissance.Text
        .Cells(lig, 4).Value = cboProfession.Text
        .Cells(lig, 5).Value = cboAssuranceHospi.Text
        .Cells(lig, 6).Value = Choose(CInt(OptnAcciCorpOui.Value) + 2, "Oui", "Non")
        .Cells(lig, 7).Value = txtCapitaux.Text
        .Cells(lig, 8).Value = txtNbPersonne.Text

    End With

    'ici, je n'ai pas touché !
    With ActiveSheet.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

        If .ListColumns("Date d'enregistrement").DataBodyRange.Rows(.ListRows.Count) <> Empty Then .ListRows.Add
        .ListColumns("Date d'enregistrement").DataBodyRange.Rows(.ListRows.Count) = "=TODAY()"

    End With

End Sub
Le 12/04/2018 à 13:00

Bonjour,

Suite à mon intervention d'hier, je te simplifie la dernière partie sans toucher aux modifications proposées par Thèze.

Le code que je t'ai soumis gère l'ajout d'une ligne au tableau, tout ce qui précède peut donc être y reporté

Private Sub btnAjouter_Click()

    'message et sortie de procédure pour chaque test
    If txtNom = "" Then MsgBox "Veuillez saisir le nom du client": txtNom.SetFocus: Exit Sub

    If txtPrenom = "" Then MsgBox "Veuillez saisir le prénom du client": txtPrenom.SetFocus: Exit Sub

    If txtDateNaissance = "" Then MsgBox "Veuillez saisir la date de naissance du client": txtDateNaissance.SetFocus: Exit Sub

    If cboProfession = "" Then MsgBox "Veuillez sélectionner la profession du client": cboProfession.SetFocus: Exit Sub

    If cboPaiement = "" Then MsgBox "Veuillez sélectionner la fréquence de paiement": cboPaiement.SetFocus: Exit Sub

    If txtNbPersonne = "" Then MsgBox "Veuillez saisir le nombre de personne à assurer auprès du client": txtNbPersonne.SetFocus: Exit Sub

    If OptnAcciCorpNon = False And OptnAcciCorpOui = False Then MsgBox "Veuillez choisir si le client prend une assurance d'accidents corporels du client": Exit Sub

    'ici, je n'ai pas touché !
    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) = txtNbPersonne.Text
        .ListColumns("Date d'enregistrement").DataBodyRange.Rows(.ListRows.Count) = "=TODAY()"

    End With

End Sub

NB : Les numéros de colonnes du tableau penvent être remplacés par les noms de colonnes pour simplifier la lecture du code.

Le 12/04/2018 à 17:50

Merci à vous 2

capture bdd 2 capture bdd 3

Les données sont à titre indicatif, je dois encore paramétrer les données possible à être saisie, les caractères,...

Le 12/04/2018 à 17:53

J'ai juste un soucis lors de l'enregistrement je voudrais que la date du jour reste dans la base de donnée et non que la date de tous les enregistrements se modifie tous les jours

Le 12/04/2018 à 18:23

il suffit de modifier cette instruction

.ListColumns("Date d'enregistrement").DataBodyRange.Rows(.ListRows.Count) = Date
Rechercher des sujets similaires à "vba probleme affichage date"