Merci,
Aucun soucis pour le code, cela marche. J'ai juste fait les modifications par rapport au value des textbox.
Le code:
"Private Sub WriteRecord(ByVal RecordNumber As Long)
Dim dateref1, dateRef2 As Date ' Declare variables.
Dim IntervalType As String 'm pour ajouter des mois y pour des jours
Dim Nombre_Ajout As Integer 'nombre de mois ou de jour à ajouter à la date de référence
dateref1 = txtDebutConge.Value 'date début des congés
IntervalType = "m" ' Ajout de mois
Nombre_Ajout = 6 ' 6 mois
txtfinConge.Value = DateAdd(IntervalType, Nombre_Ajout, dateref1) - 1 ' 6 mois - 1 jour
Nombre_Ajout = 3 'Ajout de 3 mois
txtConPatient.Value = DateAdd(IntervalType, Nombre_Ajout, dateref1) + 1 ' 3 mois + 1 jour
dateRef2 = txtfinConge.Value ' date fin des congés
IntervalType = "y" ' Ajout ou retrait de jours
Nombre_Ajout = -70 ' - 70 jours
txtRdvAmAvant.Value = DateAdd(IntervalType, Nombre_Ajout, dateRef2) 'fin de congés - 70 jours
Nombre_Ajout = -50 ' - 50 jours
txtRdvHiaAvant.Value = DateAdd(IntervalType, Nombre_Ajout, dateRef2) 'Fin de congés - 50 jours
' Ecriture de l'enregistrement
Me.cboMember.ListIndex = -1
RecordNumber = RecordNumber + 1
With rng
With .Cells(RecordNumber, 1)
If Len(.Value) = 0 Then ' ID
' .Value = Application.WorksheetFunction.Max(rng.Columns(1)) + 1
End If
'.NumberFormat = "\R000" ' Format
'impose saisie Nom
If Me.txtName.Value = "" Then
MsgBox "Vous devez saisir une Nom !"
Me.txtName.SetFocus
Exit Sub
End If
'impose saisie Prénom
If Me.txtFirstName.Value = "" Then
MsgBox "Vous devez saisir un prénom !"
Me.txtFirstName.SetFocus
Exit Sub
End If
'impose saisie Identifiant
If Me.txtId.Value = "" Then
MsgBox "Vous devez saisir un Identifiant !"
Me.txtId.SetFocus
Exit Sub
End If
End With
.Cells(RecordNumber, 1) = Me.txtGrade
.Cells(RecordNumber, 2) = Me.txtName
.Cells(RecordNumber, 3) = Me.txtFirstName
.Cells(RecordNumber, 4) = Me.txtDateNaissance
.Cells(RecordNumber, 5) = Me.txtAppartenance
.Cells(RecordNumber, 6) = Me.txtArs
.Cells(RecordNumber, 7) = Me.txtId
.Cells(RecordNumber, 8) = Me.txtRecpLivAnt
.Cells(RecordNumber, 9) = Me.txtOrganismeGestion
.Cells(RecordNumber, 10) = Me.cboTypeConge
.Cells(RecordNumber, 11) = Me.cboPeriode
.Cells(RecordNumber, 12) = Me.txtDebutConge
.Cells(RecordNumber, 13) = Me.txtfinConge
.Cells(RecordNumber, 14) = Me.txtConPatient
.Cells(RecordNumber, 15) = Me.txtRdvAmAvant
.Cells(RecordNumber, 16) = Me.txtRdvHiaAvant
.Cells(RecordNumber, 17) = Me.txtRdvAntenne
.Cells(RecordNumber, 18) = Me.txtRdvHia
.Cells(RecordNumber, 19) = Me.cboTypologieBlessures
.Cells(RecordNumber, 20) = Me.cboAT
.Cells(RecordNumber, 21) = Me.txtEnvOG & "-" & Me.txtMsgOrgaGest
.Cells(RecordNumber, 22) = Me.txtEnvOG
.Cells(RecordNumber, 23) = Me.txtMsgOrgaGest
.Cells(RecordNumber, 24) = Me.txtEnvIRASS
.Cells(RecordNumber, 25) = Me.txtAdresse & "-" & Me.txtVille & "-" & Me.txtCP & "-" & Me.txtTelephone
.Cells(RecordNumber, 26) = Me.txtAdresse
.Cells(RecordNumber, 27) = Me.txtVille
.Cells(RecordNumber, 28) = Me.txtCP
.Cells(RecordNumber, 29) = Me.txtTelephone
.Cells(RecordNumber, 30) = Me.txtObservation
End With
Me.cboMember.ListIndex = CurrentRecord
End Sub"
Par contre, je me pose la question si une condition pour une non saisie de la Textbox qui sert à dateref1 peut être utile ?
En général, les dossiers comportent une date de début mais il arrive que cette date ne figure pas ce qui implique un bug.