Nouvel enregistrement prnd la place d'un exixtant dans la table

Le
Marie-Claire
Bonjour,
Décidément 2010 n'est pas une année pour moi.

Je dois faire un agenda et pour cela je m'inspire de agendamedv3.1 que j'ai
trouvé sur http://denishulo.developpez.com/tutoriels/access/planningv1/

Cette application prévoit qu'au clic sur une case planning le formulaire
Patient s'ouvre pour créer le rdv.
Or pour des raisons de lecture des indications sur le mémo je dois avoir les
deux formulaires ouverts simultanément, alors dans le formulaire planning
j'ai introduit le formulaire Patient en sous formulaire.
Problème les nouvelles saisies de rdv s'inscrivent dans la table
T_RendezVous en en effaçant un autre.
C'est-à dire que je ne crée jamais de nouveau rendez-vous.
Voici les codes:

Lorsque l'on clique sur une plage du planning:


la fonction OuvrirFormRendezVous

Public Function OuvrirFormRendezVous(i As Integer, j As Integer)

Dim DateC As Date
Dim DateD As Date
Dim DateF As Date

DateC = IndicesToHoraire(i, j)


DateD = Nz(DLookup("[HoraireDebut]", "T_RendezVous", "(Salle= '" &
Nz(Forms!F_Planning!Salle, "") & "') and HoraireDebut<=" &
FormatDateUS(DateC) & " And HoraireFin>" & FormatDateUS(DateC)), DateC)
DateF = Nz(DLookup("[HoraireFin]", "T_RendezVous", "(Salle= '" &
Nz(Forms!F_Planning!Salle, "") & "') and HoraireDebut<=" &
FormatDateUS(DateC) & " And HoraireFin>" & FormatDateUS(DateC)), DateAdd("n",
30, DateC))

Forms!F_Planning!F_RendezVous.SetFocus
Forms!F_Planning!F_RendezVous.Form!DateRdV1 = Format(DateD, "dd/mm/yyyy")
Forms!F_Planning!F_RendezVous.Form!DateRdV2 = Format(DateF, "dd/mm/yyyy")

Forms!F_Planning!F_RendezVous.Form!HoraireD = Format(DateD, "hh:nn")
Forms!F_Planning!F_RendezVous.Form!HoraireF = Format(DateF, "hh:nn")
Forms!F_Planning!Salle = Forms!F_Planning!F_RendezVous.Form!Salle




End Function
'-
Sur clic OK:

Private Sub CmdValider_Click()
' Valide les choix effectués sur le formulaire "F_RendezVous"

Dim HD As Date, HF As Date, HDD As Date, HHD As Date, HHF As Date
Dim n As Long


DoCmd.OpenForm "F_Planning", acNormal


' Si les zones de texte "NP" ou "Memo" ne sont pas vides

If ((Me!NP <> "") And Not IsNull(Me!NP)) Or ((Me!Memo <> "") And Not
IsNull(Me!Memo)) Then
HD = CDate(Format(Me!DateRdV1, "dd/mm/yy ") & Me!HoraireD)
HF = CDate(Format(Me!DateRdV2, "dd/mm/yy ") & Me!HoraireF)
HDD = CDate(Format(Me!DateRdV1, "dd/mm/yy "))
HHD = CDate(Format(Me!HoraireD, "hh:mm"))
HHF = CDate(Format(Me!HoraireF, "hh:mm"))



If (Format(HF, "hh:nn") <= "18:00") And (HD < HF) Then

' On recherche des RDV dont les horaires de début et de fin chevauchent les
' horaires choisis sur le formulaire.

n = Nz(DLookup("[NR]", "T_RendezVous", "(NR<>" & Nz(Me!NR, 0) & ") And
HoraireDebut<" & FormatDateUS(HF) & " And HoraireFin>" & FormatDateUS(HD)), 0)

' si aucun RDV n'a été trouvé, la plage horaire est donc disponible et on peut
' enregistrer le RDV.

If (n = 0) Then
Me!HoraireDebut = HD
Me!HoraireFin = HF
Me!DateRDV = HDD
Me!Hdebut = HHD
Me!Hfin = HHF
Me.Requery
MajPlanning
'DoCmd.Close

Else
msgbox ("Veuillez sélectionner un résidant !")

End If

Else
msgbox ("Saisie incorrecte 2 !")

End If

Else
msgbox ("Saisie incorrecte 3 !")
End If

End Sub
'

Public Sub MajPlanning()

Dim RsPL As DAO.Recordset
Dim Ligne As Integer, Col As Integer
Dim LeSql As String
Dim i As Integer, d As Integer
Dim Color As Long


LeSql = "SELECT R_RendezVous.* " & _
"FROM R_RendezVous " & _
"WHERE (Salle= '" & Nz(Forms!F_Planning!Salle, "") & "') and
(R_RendezVous.HoraireDebut < " & FormatDateUS(DateDebut + 7) & ") And
(R_RendezVous.HoraireFin >" & FormatDateUS(DateDebut) & ")"

Set RsPL = CurrentDb.OpenRecordset(LeSql, dbOpenForwardOnly)



Forms!F_Planning!Titre.Caption = "PLANNING DE LA SEMAINE DU " &
UCase(Format(DateDebut, "dd mmmm yyyy")) & " AU " & UCase(Format(DateDebut +
6, "dd mmmm yyyy"))
Forms!F_Planning!DateD.Value = Date




InitPlanning

Do While Not (RsPL.EOF)

If Not IsNull(RsPL!Couleur) Then
Color = RsPL!Couleur

Else
Color = vbWhite

End If

If DateDiff("d", RsPL!HoraireDebut, RsPL!HoraireFin) = 0 Then

Col = IndiceColonne(RsPL!HoraireDebut)
Ligne = PremierCreneau(RsPL!HoraireDebut)

d = DateDiff("n", RsPL!HoraireDebut, RsPL!HoraireFin) 15

Forms!F_Planning!Planning.Form("creneau" & Ligne & "_" &
Col).Height = 295 * d

If Not IsNull(RsPL!NP) Then
Forms!F_Planning!Planning.Form("creneau" & Ligne & "_" &
Col).Caption = CentrerTexte(RsPL!Residant, d)
Else
Forms!F_Planning!Planning.Form("creneau" & Ligne & "_" &
Col).Caption = CentrerTexte(Nz(RsPL!Memo, ""), d)
End If

Forms!F_Planning!Planning.Form("creneau" & Ligne & "_" &
Col).BackColor = Color

Else

MajCongé RsPL!HoraireDebut, RsPL!HoraireFin, RsPL!Memo, Color

End If

RsPL.MoveNext
Loop



RsPL.Close
Set RsPL = Nothing

End Sub
'--
la fonction InitPlanning

Private Sub InitPlanning()

Dim i As Integer, j As Integer
Dim DateC As Date ' date courante qui prend successivement les valeurs des
jours de la semaine

For i = 1 To 40

For j = 1 To 7

If (Forms!F_Planning!Planning.Form("creneau" & i & "_" & j).Caption <>
"") Then
Forms!F_Planning!Planning.Form("creneau" & i & "_" & j).Caption = ""
End If

If (i Mod 2) = 1 Then ' on alterne les couleurs de lignes
If Forms!F_Planning!Planning.Form("creneau" & i & "_" &
j).BackColor <> -2147483624 Then
Forms!F_Planning!Planning.Form("creneau" & i & "_" &
j).BackColor = -2147483624
End If
Else
If Forms!F_Planning!Planning.Form("creneau" & i & "_" &
j).BackColor <> vbWhite Then
Forms!F_Planning!Planning.Form("creneau" & i & "_" &
j).BackColor = vbWhite
End If
End If

If Forms!F_Planning!Planning.Form("creneau" & i & "_" & j).Height <>
295 Then
Forms!F_Planning!Planning.Form("creneau" & i & "_" & j).Height =
295 ' on définit la hauteur des lignes
End If

Next j

Next i

For i = 1 To 7

DateC = DateAdd("d", (i - 1), DateDebut)
Forms!F_Planning!Planning.Form("Col" & i).Caption = Format(DateC, "Ddd dd
mmm yyyy")

If EstFerie(DateC) Or Not (EstWeek(DateC)) Then 'on colorie les en-têtes
(rouge pour les week-end)
Forms!F_Planning!Planning.Form("Col" & i).BackColor = 16761087
ColorierColonne i, 16772351
Else
Forms!F_Planning!Planning.Form("Col" & i).BackColor = 16761024
End If

Next i

End Sub


Est-ce que vous avez le truc, ou est-ce que vous voyez l’erreur que j’ai pu
faire.
Merci d’avance.
Marie-Claire

--
Marie-Claire
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Michel__D
Le #20933321
Bonjour,

Marie-Claire a écrit :
Bonjour,
Décidément 2010 n'est pas une année pour moi.

Je dois faire un agenda et pour cela je m'inspire de agendamedv3.1 que j'ai
trouvé sur http://denishulo.developpez.com/tutoriels/access/planningv1/




Mouais j'ai pas l'impression que tu t'inspire de agendamedv3.1 mais
plutôt que tu cherche à le modifier
pour qu'il correponde à ton besoin, as-tu essayer de contacter le
concepteur ?

Cette application prévoit qu'au clic sur une case planning le formulaire
Patient s'ouvre pour créer le rdv.
Or pour des raisons de lecture des indications sur le mémo je dois avoir les
deux formulaires ouverts simultanément, alors dans le formulaire planning
j'ai introduit le formulaire Patient en sous formulaire.
Problème les nouvelles saisies de rdv s'inscrivent dans la table
T_RendezVous en en effaçant un autre.
C'est-à dire que je ne crée jamais de nouveau rendez-vous.
Voici les codes:

Lorsque l'on clique sur une plage du planning:


la fonction OuvrirFormRendezVous

Public Function OuvrirFormRendezVous(i As Integer, j As Integer)

Dim DateC As Date
Dim DateD As Date
Dim DateF As Date

DateC = IndicesToHoraire(i, j)


DateD = Nz(DLookup("[HoraireDebut]", "T_RendezVous", "(Salle= '" &
Nz(Forms!F_Planning!Salle, "") & "') and HoraireDebut<=" &
FormatDateUS(DateC) & " And HoraireFin>" & FormatDateUS(DateC)), DateC)
DateF = Nz(DLookup("[HoraireFin]", "T_RendezVous", "(Salle= '" &
Nz(Forms!F_Planning!Salle, "") & "') and HoraireDebut<=" &
FormatDateUS(DateC) & " And HoraireFin>" & FormatDateUS(DateC)), DateAdd("n",
30, DateC))

Forms!F_Planning!F_RendezVous.SetFocus
Forms!F_Planning!F_RendezVous.Form!DateRdV1 = Format(DateD, "dd/mm/yyyy")
Forms!F_Planning!F_RendezVous.Form!DateRdV2 = Format(DateF, "dd/mm/yyyy")

Forms!F_Planning!F_RendezVous.Form!HoraireD = Format(DateD, "hh:nn")
Forms!F_Planning!F_RendezVous.Form!HoraireF = Format(DateF, "hh:nn")
Forms!F_Planning!Salle = Forms!F_Planning!F_RendezVous.Form!Salle




End Function
'----------------------------------------------------------------
Sur clic OK:

Private Sub CmdValider_Click()
' Valide les choix effectués sur le formulaire "F_RendezVous"

Dim HD As Date, HF As Date, HDD As Date, HHD As Date, HHF As Date
Dim n As Long


DoCmd.OpenForm "F_Planning", acNormal


' Si les zones de texte "NP" ou "Memo" ne sont pas vides

If ((Me!NP <> "") And Not IsNull(Me!NP)) Or ((Me!Memo <> "") And Not
IsNull(Me!Memo)) Then
HD = CDate(Format(Me!DateRdV1, "dd/mm/yy ") & Me!HoraireD)
HF = CDate(Format(Me!DateRdV2, "dd/mm/yy ") & Me!HoraireF)
HDD = CDate(Format(Me!DateRdV1, "dd/mm/yy "))
HHD = CDate(Format(Me!HoraireD, "hh:mm"))
HHF = CDate(Format(Me!HoraireF, "hh:mm"))



If (Format(HF, "hh:nn") <= "18:00") And (HD < HF) Then

' On recherche des RDV dont les horaires de début et de fin chevauchent les
' horaires choisis sur le formulaire.

n = Nz(DLookup("[NR]", "T_RendezVous", "(NR<>" & Nz(Me!NR, 0) & ") And
HoraireDebut<" & FormatDateUS(HF) & " And HoraireFin>" & FormatDateUS(HD)), 0)

' si aucun RDV n'a été trouvé, la plage horaire est donc disponible et on peut
' enregistrer le RDV.

If (n = 0) Then
Me!HoraireDebut = HD
Me!HoraireFin = HF
Me!DateRDV = HDD
Me!Hdebut = HHD
Me!Hfin = HHF
Me.Requery
MajPlanning
'DoCmd.Close

Else
msgbox ("Veuillez sélectionner un résidant !")

End If

Else
msgbox ("Saisie incorrecte 2 !")

End If

Else
msgbox ("Saisie incorrecte 3 !")
End If

End Sub
'------------------------------------------------------------------------

Public Sub MajPlanning()

Dim RsPL As DAO.Recordset
Dim Ligne As Integer, Col As Integer
Dim LeSql As String
Dim i As Integer, d As Integer
Dim Color As Long


LeSql = "SELECT R_RendezVous.* " & _
"FROM R_RendezVous " & _
"WHERE (Salle= '" & Nz(Forms!F_Planning!Salle, "") & "') and
(R_RendezVous.HoraireDebut < " & FormatDateUS(DateDebut + 7) & ") And
(R_RendezVous.HoraireFin >" & FormatDateUS(DateDebut) & ")"

Set RsPL = CurrentDb.OpenRecordset(LeSql, dbOpenForwardOnly)



Forms!F_Planning!Titre.Caption = "PLANNING DE LA SEMAINE DU " &
UCase(Format(DateDebut, "dd mmmm yyyy")) & " AU " & UCase(Format(DateDebut +
6, "dd mmmm yyyy"))
Forms!F_Planning!DateD.Value = Date




InitPlanning

Do While Not (RsPL.EOF)

If Not IsNull(RsPL!Couleur) Then
Color = RsPL!Couleur

Else
Color = vbWhite

End If

If DateDiff("d", RsPL!HoraireDebut, RsPL!HoraireFin) = 0 Then

Col = IndiceColonne(RsPL!HoraireDebut)
Ligne = PremierCreneau(RsPL!HoraireDebut)

d = DateDiff("n", RsPL!HoraireDebut, RsPL!HoraireFin) 15

Forms!F_Planning!Planning.Form("creneau" & Ligne & "_" &
Col).Height = 295 * d

If Not IsNull(RsPL!NP) Then
Forms!F_Planning!Planning.Form("creneau" & Ligne & "_" &
Col).Caption = CentrerTexte(RsPL!Residant, d)
Else
Forms!F_Planning!Planning.Form("creneau" & Ligne & "_" &
Col).Caption = CentrerTexte(Nz(RsPL!Memo, ""), d)
End If

Forms!F_Planning!Planning.Form("creneau" & Ligne & "_" &
Col).BackColor = Color

Else

MajCongé RsPL!HoraireDebut, RsPL!HoraireFin, RsPL!Memo, Color

End If

RsPL.MoveNext
Loop



RsPL.Close
Set RsPL = Nothing

End Sub
'-----------------------------------------------------------------------------------------------------------------
la fonction InitPlanning

Private Sub InitPlanning()

Dim i As Integer, j As Integer
Dim DateC As Date ' date courante qui prend successivement les valeurs des
jours de la semaine

For i = 1 To 40

For j = 1 To 7

If (Forms!F_Planning!Planning.Form("creneau" & i & "_" & j).Caption <>
"") Then
Forms!F_Planning!Planning.Form("creneau" & i & "_" & j).Caption = ""
End If

If (i Mod 2) = 1 Then ' on alterne les couleurs de lignes
If Forms!F_Planning!Planning.Form("creneau" & i & "_" &
j).BackColor <> -2147483624 Then
Forms!F_Planning!Planning.Form("creneau" & i & "_" &
j).BackColor = -2147483624
End If
Else
If Forms!F_Planning!Planning.Form("creneau" & i & "_" &
j).BackColor <> vbWhite Then
Forms!F_Planning!Planning.Form("creneau" & i & "_" &
j).BackColor = vbWhite
End If
End If

If Forms!F_Planning!Planning.Form("creneau" & i & "_" & j).Height <>
295 Then
Forms!F_Planning!Planning.Form("creneau" & i & "_" & j).Height =
295 ' on définit la hauteur des lignes
End If

Next j

Next i

For i = 1 To 7

DateC = DateAdd("d", (i - 1), DateDebut)
Forms!F_Planning!Planning.Form("Col" & i).Caption = Format(DateC, "Ddd dd
mmm yyyy")

If EstFerie(DateC) Or Not (EstWeek(DateC)) Then 'on colorie les en-têtes
(rouge pour les week-end)
Forms!F_Planning!Planning.Form("Col" & i).BackColor = 16761087
ColorierColonne i, 16772351
Else
Forms!F_Planning!Planning.Form("Col" & i).BackColor = 16761024
End If

Next i

End Sub


Est-ce que vous avez le truc, ou est-ce que vous voyez l’erreur que j’ai pu
faire.
Merci d’avance.
Marie-Claire




Publicité
Poster une réponse
Anonyme