Lancement d'une sous procédure et retour à la ligne pour poursuivre

Comment envoyer mes codes comme vous le faite sur ce site, svp? Merci

j'ai voulu automatiser la création du n° de devis et du n° facture

Pourquoi vous le mettez tous les codes dans votre fichier ?

Il bug dans la boucle If sur l'écriture

Dans quelle boucle ? et sur quelle ligne
Je suppose que vous parlez du code Private Sub btnAjout_Click() dans le frmRDV ?
Dites moi ce que vous faites que je reproduise sur votre fichier

Comment envoyer mes codes comme vous le faite sur ce site, svp? Merci

Vous copiez votre code, puis vous cliquez sur l'icone "Code" (</>) dans la barre des icones du post.

'Procédure permettant d'ajouter un nouvel enregistrement dans la base de données
Private Sub btnAjout_Click()
With Worksheets("RdV").ListObjects("TRDV")
    If .ListRows.Count = 0 Then
        .ListRows.Add: lig = 1
    Else: .ListRows.Add: lig = .ListRows.Count 'insérer à la dernière ligne
    End If
    .DataBodyRange.Item(lig, 1) = cboPatiente.Value
    .DataBodyRange.Item(lig, 2) = cboBebe.Value
    .DataBodyRange.Item(lig, 3) = Format(txtDRdV.Value, "mm/dd/yyyy")
    .DataBodyRange.Item(lig, 4) = Format(txtHRdV.Value, "hh:mm")
    .DataBodyRange.Item(lig, 5) = cboLieu.Value
    .DataBodyRange.Item(lig, 6) = cboModeP.Value
    .DataBodyRange.Item(lig, 8) = txtMontant.Value
    'rechercher la valeur maxi
    MaxDev = Range("U1").Value
    MaxFact = Range("W1").Value
    AnFact = Right(Year(txtDRdV), 2)
    'Recherche si chèque ou virement existe
    If cboModeP = "Chèque" Or cboModeP = "Virement" Then
        NumDev = MaxDev + 1
        NumDev = Format(NumDev, "000")
        NumFact = MaxFact + 1
        NumFact = Format(NumFact, "000")
        Devis = "DEV-" & NumDev & "-" & AnFact
        .DataBodyRange.Item(lig, 11) = NumDev.Value
        .DataBodyRange.Item(lig, 12) = Devis.Value
        Facture = "FACT-" & NumFact & "-" & AnFact
        .DataBodyRange.Item(lig, 13) = NumFact.Value
        .DataBodyRange.Item(lig, 14) = Facture.Value
       Else
        NumRDV = ""
        Devis = "DEV-000-00"
        Facture = " "
    End If
    .DataBodyRange.Item(lig, 15) = cboCR.Value
    'Format du nom de fichier
    Fiche = "FR" & " " & cboPatiente & " / " & cboBebe & "__" & Format(txtDRdV, "YYYYMMDD")
    .DataBodyRange.Item(lig, 16) = Fiche
    .DataBodyRange.Item(lig, 17) = cboStatut.Value
    .DataBodyRange.Item(lig, 18) = txtResume.Value
MsgBox "Votre rendez-vous et votre paiement ont bien été ajoutés à votre base de données", vbOKOnly + vbInformation, "CONFIRMATION"
End With
End Sub

'Gestion du choix de la mamam
Private Sub cboPatiente_Change()
Dim Cel As Range
cboBebe.Clear
For Each Cel In Worksheets("Bebe").ListObjects("TBebe").ListColumns(4).DataBodyRange
    If Cel.Offset(0, -3) = cboPatiente.Value Then cboBebe.AddItem Cel.Value
Next Cel
End Sub

Dans la recherche si chèque ou virement. Je souhaite aromatiser la création du numéro du devis et de la facture.

Inscrire colonne 11 le numéro devis (NumDevis), colonne 12 le nom du fichier devis (Devis), colonne 13 le numéro de facture (NumFact), colonne 14 le nom du fichier facture (Facture).

La numérotation est prise en cellule U1 pour devis et cellule W1 pour facture. (La création est automatique, mais si pas de devis de créer pour la patiente, j'efface manuellement le numéro et le nom du fichier devis. Idem pour facture. Une facture n'est pas systématique. Si je garde devis et:/ou facture, je créer manuellement un lien hypertexte vers ce fichier.

J'espère avoir était clair dans mes explications.

Ok pour vos explications mais vous ne répondez pas aux questions que j'ai posées avant

J'ai bien compris que c'est sur le frmRdv mais vous parliez de bug....

Je vais regarder en collant votre code sur le fichier que vous aviez envoyé

Oui, le frm s'ouvre bien, le choix maman bébé OK. L'ensemble de la saisie OK. Il écrit tout sauf les numéros de devis, factures et les noms des fichiers. Il bug comme je l'ai écrit et mis la copie d'écran sur la ligne .DataBodyRange.Item(lig, 11) = NumDev.Value, et si je mets une apostrophe c'est sur la suivante.

Il bug comme je l'ai écrit et mis la copie d'écran sur la ligne .

Je ne vois pas de copie écran. Attention si vous faites une copie écran vous devez mettre l'image car dans le code posté cela ne se voit pas. Mais bon j'ai compris que le souci est suite à l'ajout du IF que vous avez mis dans le code.

1. Je n'ai pas compris dans votre code les 3 lignes juste en dessous du ELSE. Que cherchez vous à faire si la combobox ne comporte pas Chèque ou Virement ?

2. Autre question importante : Est-ce que toute les rubriques doivent toujours être complétées dans cette frmRDV ou pas ?

1. Effectivement pas utile le Else

2 toutes les colonnes sauf G saisie manuelle 1x/mois (n° de virement et/ou n) dépôt de chèque), colonne I et J pour les statistiques (extraction du mois, et extraction année). Peut-être fait en VBA en automatique pas eu le temps de me pencher sur ce sujet

  'année
    Annee = Right(Year(txtDRdV), 4)
    .DataBodyRange.Item(lig, 10) = Annee.Value

cela pourrait-il convenir juste avant rechercher la valeur maxi ?

2 toutes les colonnes sauf G saisie manuelle 1x/mois (n° de virement et/ou n) dépôt de chèque), colonne I et J pour les statistiques (extraction du mois, et extraction année). Peut-être fait en VBA en automatique pas eu le temps de me pencher sur ce sujet

Point 2: vous n'avez pas compris. je ne vous parlais pas de votre feuille mais du frmrdv

cela pourrait-il convenir juste avant rechercher la valeur maxi ?

Faite ceci plutôt

 .DataBodyRange.Item(lig, 10) = Right(Year(txtDRdV), 4)

oui à la question 2 pour le frmRdV

Point 2 : Ok. Je continue les modifications

Dans le frmrdv, pour votre date rendez vous, ajoutez déjà ces deux codes qui vont permettre de controler que votre date est au bon format

Private Sub TxtDRdv_Change()
Dim Valeur As String

txtDRdV.MaxLength = 10 'nb caractères maxi autorisé dans le textbox
Valeur = Len(txtDRdV)
If Valeur = 2 Or Valeur = 5 Then
    txtDRdV = txtDRdV & "/"
End If
End Sub

Private Sub TxtDRdv_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsDate(txtDRdV.Text) Or Len(txtDRdV) < 10 Then
    MsgBox "Date incorrecte !" & vbCrLf & "Veuillez mettre la date au format dd/mm/aaaa"
    Cancel = True
End If
End Sub

Dites moi si ok pour ce code. Cela vous empêchera de mettre les / lors de l'entrée d'une date et de vérifier qu'il s'agit d'une date

Je continue pour le bug en question

Bonjour,

J'ai extrait la condition pour création devis et facture. Le frm fonctionne sans cela.

J'ai donc crée un module pour l'écriture de cette condition et voici le résultat. NDev= 5, NmDev="005",NFact=59,NmFact="059",Devis= "DEV-005-21",facture="FACT-059-21". Tout cela OK puis lors de l'écriture seul NDev s'inscrit dans la bonne colonne, les 3 autres revoie le code erreur 424 Objet requis

Private Sub DevisFacture()
Sheets("RdV").Activate
'Range("A1").Select

'Calcul hors frm
Dim NumDev As Variant
Dim NumFact As Variant
Dim Devis As Variant
Dim facture As Variant
'rechercher la valeur maxi
    NumLig = Range("Y1").Value + 1
    MaxDev = Range("U1").Value
    MaxFact = Range("W1").Value
    DRdV = Cells(NumLig, 3).Value
    AnFact = Right(Year(DRdV), 2)
'Recherche si chèque ou virement existe
    Mode = Cells(NumLig, 6).Value
    If Mode = "Chèque" Or Mode = "Virement" Then
        NDev = MaxDev + 1
        NmDev = Format(NDev, "000")
        NFact = MaxFact + 1
        NmFact = Format(NFact, "000")
        Devis = "DEV-" & NmDev & "-" & AnFact
        Sheets("RdV").Cells(NumLig, 11).Value = NDev
        Sheets("RdV").Cells(NumLig, 12).Value = Devis.Value
        facture = "FACT-" & NmFact & "-" & AnFact
        Sheets("RdV").Cells(NumLig, 13).Value = NFact.Value
        Sheets("RdV").Cells(NumLig, 14).Value = facture.Value
    End If

'Sélection feuille Accueil
Sheets("Accueil").Activate

End Sub

. Voici le code. Cela peut aider. Je poursuis mes recherches. Merci

J'ai trouvé peut-être que tout n'est pas très "catholique" mais cela fonctionne

Voici le code

'Procédure permettant d'ajouter un nouvel enregistrement dans la base de données
Private Sub btnAjout_Click()
With Worksheets("RdV").ListObjects("TRDV")
    If .ListRows.Count = 0 Then
        .ListRows.Add: Lig = 1
    Else: .ListRows.Add: Lig = .ListRows.Count 'insérer à la dernière ligne
    End If
    .DataBodyRange.Item(Lig, 1) = cboPatiente.Value
    .DataBodyRange.Item(Lig, 2) = cboBebe.Value
    .DataBodyRange.Item(Lig, 3) = Format(txtDRdV.Value, "mm/dd/yyyy")
    .DataBodyRange.Item(Lig, 4) = Format(txtHRdV.Value, "hh:mm")
    .DataBodyRange.Item(Lig, 5) = cboLieu.Value
    .DataBodyRange.Item(Lig, 6) = cboModeP.Value
    .DataBodyRange.Item(Lig, 8) = txtMontant.Value
    .DataBodyRange.Item(Lig, 9) = Format(txtDRdV.Value, "mmm")
    .DataBodyRange.Item(Lig, 10) = Format(txtDRdV.Value, "yyyy")
    .DataBodyRange.Item(Lig, 15) = cboCR.Value
    'Format du nom de fichier
    Fiche = "FR" & " " & cboPatiente & " / " & cboBebe & "__" & Format(txtDRdV, "YYYYMMDD")
    .DataBodyRange.Item(Lig, 16) = Fiche
    .DataBodyRange.Item(Lig, 17) = cboStatut.Value
    .DataBodyRange.Item(Lig, 18) = txtResume.Value
'Calcul hors frm
Sheets("Rdv").Activate
Dim NDev As Integer
Dim NFact As Integer
Dim Devis As Variant
Dim facture As Variant
'rechercher la valeur maxi
    MaxDev = Range("U1").Value
    MaxFact = Range("W1").Value
    AnFact = Right(Year(txtDRdV), 2)
'Recherche si chèque ou virement existe
    Lig = Lig + 1
    If cboModeP = "Chèque" Or cboModeP = "Virement" Then
        NDev = MaxDev + 1
        NmDev = Format(NDev, "000")
        NFact = MaxFact + 1
        NmFact = Format(NFact, "000")
        Devis = "DEV-" & NmDev & "-" & AnFact
        Sheets("RdV").Cells(Lig, 11).Value = NDev
        Sheets("RdV").Cells(Lig, 12).Value = Devis
        facture = "FACT-" & NmFact & "-" & AnFact
        Sheets("RdV").Cells(Lig, 13).Value = NFact
        Sheets("RdV").Cells(Lig, 14).Value = facture
    End If
MsgBox "Votre rendez-vous et votre paiement ont bien été ajoutés à votre base de données", vbOKOnly + vbInformation, "CONFIRMATION"
End With
End Sub

'Gestion du choix de la mamam
Private Sub cboPatiente_Change()
Dim Cel As Range
cboBebe.Clear
For Each Cel In Worksheets("Bebe").ListObjects("TBebe").ListColumns(4).DataBodyRange
    If Cel.Offset(0, -3) = cboPatiente.Value Then cboBebe.AddItem Cel.Value
Next Cel
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.cboPatiente.AddItem Item
    Next
End With
With Worksheets("Liste")
    cboLieu.List = .ListObjects("TLieux").DataBodyRange.Value
    cboModeP.List = .ListObjects("LModePaiement").DataBodyRange.Value
    cboStatut.List = .ListObjects("LStatut").DataBodyRange.Value
    cboCR.List = .ListObjects("TCR").DataBodyRange.Value
End With
End Sub

Private Sub TxtDRdV_Change()
Dim Valeur As String
txtDRdV.MaxLength = 10 'nb caractères maxi autorisé dans le textbox
Valeur = Len(txtDRdV)
If Valeur = 2 Or Valeur = 5 Then
    txtDRdV = txtDRdV & "/"
End If
End Sub

Private Sub TxtDRdv_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsDate(txtDRdV.Text) Or Len(txtDRdV) < 10 Then
    MsgBox "Date incorrecte !" & vbCrLf & "Veuillez mettre la date au format dd/mm/aaaa"
    Cancel = True
End If
End Sub

'Procédure permettant de fermer un formulaire Saisie Bébé
Private Sub btnQuitter_Click()
'Retour dans le Tableau de bord
    Sheets("Accueil").Activate
    Range("A1").Activate
    Unload Me
End Sub

Merci encore. Bel exercice pour moi

Bonjour

Je ne comprends pas pourquoi vous coller tous les codes de votre userform. Seul le code Ajout est concerné par votre dernière demande.
Voici le code Ajout que vous pouvez mettre dans votre userform RDV à la place de l'autre. J'ai supprimé une série de variables qui rallonge le code inutilement

Private Sub btnAjout_Click()
Dim lig As Long
Dim NumDev, NumFact
Dim Fiche As String
Dim AnFact As Byte

With Worksheets("RdV").ListObjects("TRDV")
    If .ListRows.Count = 0 Then
        .ListRows.Add: lig = 1
    Else: .ListRows.Add: lig = .ListRows.Count 'insérer à la dernière ligne
    End If
    .DataBodyRange.Item(lig, 1) = cboPatiente.Value 'ref patiente
    .DataBodyRange.Item(lig, 2) = cboBebe.Value ' ref beb
    .DataBodyRange.Item(lig, 3) = Format(txtDRdV.Value, "mm/dd/yyyy") 'date Rdv
    .DataBodyRange.Item(lig, 4) = Format(txtHRdV.Value, "hh:mm") 'heure rdv
    .DataBodyRange.Item(lig, 5) = cboLieu.Value 'lieu
    .DataBodyRange.Item(lig, 6) = cboModeP.Value 'paiement mode
    .DataBodyRange.Item(lig, 8) = txtMontant.Value 'montant du paiement

    'rechercher la valeur maxi
    .DataBodyRange.Item(lig, 9) = Month(txtDRdV)'Mois
    .DataBodyRange.Item(lig, 10) = Right(Year(txtDRdV), 4) 'Annee
    'Recherche si chèque ou virement existe
    If cboModeP = "Chèque" Or cboModeP = "Virement" Then
        AnFact = Right(Year(txtDRdV), 2)
        NumDev = Format(WorksheetFunction.Max(.ListColumns(11).DataBodyRange) + 1, "000")
        NumFact = Format(WorksheetFunction.Max(.ListColumns(13).DataBodyRange) + 1, "000")
        .DataBodyRange.Item(lig, 11) = NumDev.Value 'Numero devis
        .DataBodyRange.Item(lig, 12) = "DEV-" & NumDev & "-" & AnFact 'reference devis
        .DataBodyRange.Item(lig, 13) = NumFact.Value 'Numero Facture
        .DataBodyRange.Item(lig, 14) = "FACT-" & NumFact & "-" & AnFact 'reference facture
    End If

    .DataBodyRange.Item(lig, 15) = cboCR.Value
    'Format du nom de fichier
    Fiche = "FR" & " " & cboPatiente & " / " & cboBebe & "__" & Format(txtDRdV, "YYYYMMDD")
    .DataBodyRange.Item(lig, 16) = Fiche
    .DataBodyRange.Item(lig, 17) = cboStatut.Value
    .DataBodyRange.Item(lig, 18) = txtResume.Value
End With

MsgBox "Votre rendez-vous et votre paiement ont bien été ajoutés à votre base de données", vbOKOnly + vbInformation, "CONFIRMATION"

End Sub

Deux remarques :
- Les lignes "mois" (..Item(lig,9) et "annee" (..item (Lig,10) dans le code qui concernent le mois et l'année pourraient être remplacées par une formule. Ces formules seraient placée dans les colonnes I et J et feraient appel à la colonne C dans votre feuille RDV. Cela donnerait ceci : en colonne I --> =MOIS([@DateRdV]) et en colonne J --> =ANNEE([@DateRdV]). Du coup les deux lignes dans le code pourraient être supprimées. A vous de voir si intérêt ou pas.
- Le code ne comprend pas encore le controle que toutes les rubriques soient complétées pour pouvoir ajouter les données dans la feuille Rdv

Cordialement

Merci pour vos remarques. Je vais exploiter tout cela. J'ai déjà appris pas mal de chose et il en reste....

Merci encore