Discussion :

[LiseUEMPT]

Bonjour,
Besoin de votre aide.
J'ai écrit ce code pour avoir un rapport format PDF pour 1 code de projet (ScodeProjet) et pour 1 date de mise à jour spécifique (sDateModif).
Le code s'exécute bien, le fichier est sauvegardé avec le bon nom,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
Option Compare Database
Option Explicit
 
Dim ScodeProjet, lCodeProjet As String
Dim MESSAGE, Msg, Style, Title, Reponse, Default
Dim Fichier As String
 
'------------
Dim sql As String
Dim sDateModif
Dim resultatLCode, resultatDat, resultatDatSeul, resultatNomP, resultatPNomP, resultatEkol, resultatCS As String
Dim resultatDat1, resultatDat2, resultatDat3, resultatDat4, resultatDat5, resultatDat6 As String
Dim Paramètre, NomFichier
 
Sub AccProjet1DPbis2()   '-'-'-'- 3oct2021
On Error GoTo AccProjet1DPBis2_err
Fichier = "AccordAllocationProjetDP"  '
 
ChDir "C:\Users\" & Environ$("UserName") & "\OneDrive - MEES\PartageMtl\Listes\Allocation\"
 
ScodeProjet = InputBox("Saisissez le code projet  :", "Accord allocation - code de projet.", Default)
sDateModif = InputBox("Inscrire la date de modification:", "Format de la date : aaaa-mm-jj", Default)
 
 
Call NomPDF_AccMatA
'---------------
Dim Dat1
 
'code d'exécution de la requête :
sql = "SELECT [AllDateProjet] FROM TbInscriptionsDP WHERE (((TbInscriptionsDP.CodeProjet)='" & ScodeProjet & "'))"
 
 Set Dat1 = CurrentDb.OpenRecordset(sql)
 resultatDat1 = Dat1("AllDateProjet")
 MsgBox resultatDat1
'---------------
 
Paramètre = ScodeProjet & " - " & resultatCS & "-" & resultatEkol & "- " & resultatNomP & ", " & resultatPNomP & " - Allocation P1 " & resultatDat1 ' & resultatDatSeul
 
NomFichier = ScodeProjet & " - " & resultatCS & "-" & resultatEkol & "- " & resultatNomP & ", " & resultatPNomP & " - Allocation P1 " & resultatDat1
 
MsgBox resultatDatSeul
DoCmd.OutputTo acOutputReport, Fichier, acFormatPDF, Paramètre & ".pdf", False, "", , acExportQualityPrint
 
MsgBox "Répertoire <Listes\Allocation> = " & NomFichier & ".pdf", vbInformation, "Sauvegarde"
 
DoCmd.OpenReport Fichier, acViewPreview
Call ImpressionDirecte
 
 
AccProjet1DPBis2_err: Exit Sub
End Sub
 
 
'0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-
Sub NomPDF_AccMatA()
 
Dim DatModif As Recordset   ' dateModF
'code d'exécution de la requête :
 sql = "SELECT [DateModif] FROM TbInscriptionsDP WHERE (((TbInscriptionsDP.CodeProjet)='" & ScodeProjet & "'))"
 Set DatModif = CurrentDb.OpenRecordset(sql)
 resultatDat = DatModif("DateModif")
resultatDatSeul = Left(resultatDat, 10)
'MsgBox resultatDatSeul
 
Dim NomParti As Recordset
'code d'exécution de la requête :
 sql = "SELECT [NomParticipant] FROM TbInscriptionsDP WHERE (((TbInscriptionsDP.CodeProjet)='" & ScodeProjet & "'))"
 Set NomParti = CurrentDb.OpenRecordset(sql)
 resultatNomP = NomParti("NomParticipant")
'MsgBox resultatNomP
 
Dim PNomParti As Recordset
'code d'exécution de la requête :
 sql = "SELECT [PrénomParticipant] FROM TbInscriptionsDP WHERE (((TbInscriptionsDP.CodeProjet)='" & ScodeProjet & "'))"
 Set PNomParti = CurrentDb.OpenRecordset(sql)
 resultatPNomP = PNomParti("PrénomParticipant")
'MsgBox resultatPNomP
 
Dim Ekol As Recordset
'code d'exécution de la requête :
 sql = "SELECT [Ecole] FROM TbInscriptionsDP WHERE (((TbInscriptionsDP.CodeProjet)='" & ScodeProjet & "'))"
 Set Ekol = CurrentDb.OpenRecordset(sql)
 resultatEkol = Ekol("Ecole")
'MsgBox resultatEkol
 
Dim CS_S As Recordset
'code d'exécution de la requête :
 sql = "SELECT [CS] FROM TbInscriptionsDP WHERE (((TbInscriptionsDP.CodeProjet)='" & ScodeProjet & "'))"
 Set CS_S = CurrentDb.OpenRecordset(sql)
 resultatCS = CS_S("CS")
'MsgBox resultatCS
 
End Sub

malheureusement ce qu'il y a dans le rapport PDF, ce sont toutes les fiches du code de projet peu importe la date de mise à jour, ce qui correspond à

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

resultatDat1 = Dat1("AllDateProjet")

Je voudrais seulement les fiches du code projet qui correspond à la date de modification.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Dim DatModif As Recordset   ' dateModF
'code d'exécution de la requête :
 sql = "SELECT [DateModif] FROM TbInscriptionsDP WHERE (((TbInscriptionsDP.CodeProjet)='" & ScodeProjet & "'))"
 Set DatModif = CurrentDb.OpenRecordset(sql)
 resultatDat = DatModif("DateModif")
resultatDatSeul = Left(resultatDat, 10)

Je n'arrive pas à corriger pour avoir le bon rapport. J'ai travaillé beaucoup, mais j'ai quand même besoin d'aide pour arriver à la bonne solution.

Lorsque, je mets un critère de sélection sur le CodeProjet dans la requête, ça enregistrement seulement 1 fiche. Mais je dois écrire le CodeProjet 3 fois.

J'ai essayé différentes combinaisons sans succès.

Mon code n'est peut-être pas optimal, je ne suis pas très habile avec le langage SQL.

Merci à l'avance de votre aide

[hyperion13]

Salut
Sans analyse de votre code en L22 vous renseignez la variable sDateModif, et jusqu'à L93 cette variable n'est appelée nulle part. D'ailleurs quel est son format ? Date ou Texte ?
De L57 à L91, quel intérêt de créer 5 recordset différents alors qu'un seul suffit ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Dim rst As DAO.Recordset
sql = "SELECT [PrénomParticipant], [NomParticipant], [Ecole], [CS], [DateModif] FROM TbInscriptionsDP WHERE CodeProjet = '" & ScodeProjet & "'"
Set rst = CurrentDb.OpenRecordset(sql)
resultatPNomP = rst.Fields("PrénomParticipant").Value
resultatNomP = rst.Fields("NomParticipant").Value
resultatEkol = rst.Fields("Ecole").Value
resultatCS = rst.Fields("CS").Value
resultatDat = rst.Fields("DateModif").Value
resultatDatSeul = Left(rst.Fields("DateModif").Value, 10)
'MsgBox resultatDatSeul

[LiseUEMPT]

Bonjour, merci pour votre réponse,
SDateModif est de format string.
Je ne connais pas beaucoup SQL, alors après le premier recordset qui a fonctionné j'ai continué de la même façon.
Je vais mettre en pratique votre code et je vous reviens.

Merci encore

[LiseUEMPT]

Bonjour
Voici mon code corrigé, c'est moins lourd et plus facile à compendre mais, j'ai toujours le même problème, le fichier contient toutes les fiches qui correspond à AllDateProjet, sans tenir compte de la date de modification DateModif.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
Option Compare Database
Option Explicit
 
Dim ScodeProjet, lCodeProjet As String
Dim MESSAGE, Msg, Style, Title, Reponse, Default
Dim Fichier As String
 
'------------
Dim sql, sql1 As String
Dim DDateModif, resultatDDat, resultatDDateModif As Date
Dim sDateModif, resultatLCode, resultatNomP, resultatPNomP, resultatEkol, resultatCS As String
Dim resultatAllDat1, resultatDat2, resultatDat3, resultatDat4, resultatDat5, resultatDat6 As String
Dim resultatsDateModif As String
Dim Paramètre, NomFichier
 
Sub AccProjet1DPbis2()   '-'-'-'- 3oct2021
On Error GoTo AccProjet1DPBis2_err
Fichier = "AccordAllocationProjetDP"  '
 
ChDir "C:\Users\" & Environ$("UserName") & "\OneDrive - MEES\PartageMtl\Listes\Allocation\"
 
ScodeProjet = InputBox("Saisissez le code projet  :", "Accord allocation - code de projet.", Default)
'sDateModif = InputBox("Inscrire la date de modification:", "Format de la date : aaaa-mm-jj", Default)
DDateModif = InputBox("Inscrire la date de modification:", "Format de la date : aaaa-mm-jj", Default)
 
Call NomPDF_AccordBis
'---------------
'Paramètre = ScodeProjet & " - " & resultatCS & "-" & resultatEkol & "- " & resultatNomP & ", " & resultatPNomP & " - Allocation P1 " & resultatAllDat1 & "  " & resultatDDateModif     ' Extraire avec la date de modification
Paramètre = ScodeProjet & " - " & resultatCS & "-" & resultatEkol & "- " & resultatNomP & ", " & resultatPNomP & " - Allocation P1 " & resultatAllDat1 & "  " & resultatsDateModif     ' Extraire avec la date de modification
 
'NomFichier = ScodeProjet & " - " & resultatCS & "-" & resultatEkol & "- " & resultatNomP & ", " & resultatPNomP & " - Allocation P1 " & resultatAllDat1 & "  " & resultatDDateModif  'sauve avec la date de AllDateProjet
NomFichier = ScodeProjet & " - " & resultatCS & "-" & resultatEkol & "- " & resultatNomP & ", " & resultatPNomP & " - Allocation P1 " & resultatAllDat1 & "  " & resultatsDateModif  'sauve avec la date de AllDateProjet
 
 
MsgBox "resultatDDateModif  " & resultatDDateModif
 
DoCmd.OutputTo acOutputReport, Fichier, acFormatPDF, Paramètre & ".pdf", False, "", , acExportQualityPrint
 
MsgBox "Répertoire <Listes\Allocation> = " & NomFichier & ".pdf", vbInformation, "Sauvegarde"
 
DoCmd.OpenReport Fichier, acViewPreview
Call ImpressionDirecte
 
AccProjet1DPBis2_err: Exit Sub
End Sub
 
 
'0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-
Sub NomPDF_AccordBis()
Dim rst As DAO.Recordset
'sql = "SELECT [PrénomParticipant], [NomParticipant], [Ecole], [CS], [DateModif], [AllDateProjet] FROM TbInscriptionsDP WHERE CodeProjet = '" & ScodeProjet & "'" ' AND DateModif = '" & SDateModif & "'"
sql = "SELECT [PrénomParticipant], [NomParticipant], [Ecole], [CS], [DateModif], [AllDateProjet] FROM TbInscriptionsDP WHERE CodeProjet = '" & ScodeProjet & "'" And DateModif = " & DDateModif & "
 
Set rst = CurrentDb.OpenRecordset(sql)
resultatPNomP = rst.Fields("PrénomParticipant").Value
resultatNomP = rst.Fields("NomParticipant").Value
resultatEkol = rst.Fields("Ecole").Value
resultatCS = rst.Fields("CS").Value
resultatAllDat1 = rst.Fields("AllDateProjet").Value
MsgBox "resultatAllDat1   " & resultatAllDat1
 
resultatsDat = rst.Fields("DateModif").Value
resultatDDat = rst.Fields("DateModif").Value
MsgBox "resultatsDat  " & resultatsDat
MsgBox "resultatdDat  " & resultatDDat
 
resultatDDateModif = Left(rst.Fields("DateModif").Value, 10)
resultatsDateModif = Left(rst.Fields("DateModif").Value, 10)
MsgBox "resultatDDateModif  " & resultatDDateModif
MsgBox "resultatsDateModif  " & resultatsDateModif
End Sub

J'ai fait des tests en déclarant sDateModif au format string dans la BD DateModif est déclaré Date format : aaaa-mm-jj

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

sql = "SELECT [PrénomParticipant], [NomParticipant], [Ecole], [CS], [DateModif], [AllDateProjet] FROM TbInscriptionsDP WHERE CodeProjet = '" & ScodeProjet & "'" AND DateModif = '" & SDateModif & "'"

La ligne est toute rouge et je n'arrive pas à corriger la syntaxe.

J'ai réécrit la ligne en déclarant DDateModif au format Date

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

sql = "SELECT [PrénomParticipant], [NomParticipant], [Ecole], [CS], [DateModif], [AllDateProjet] FROM TbInscriptionsDP WHERE CodeProjet = '" & ScodeProjet & "'" And DateModif = " & DDateModif & "

Un message d'erreur de compilation <Variable non définie> s'affiche.

Alors on fait comment pour appeler la variable DateModif?

Si vous pouviez m'éclairer ça serait apprécié. Je suis vraiment débutante et absolument perdue

J'attends impatiemment vos réponses. Merci

[hyperion13]

Vous pouvez tester que la valeur saisie dans InputBox est bien un format Date ISO8601

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
sDateModif = Eval("InputBox(""Inscrire la date de modification:"",""Format de la date : aaaa-mm-jj"", date())")
If Not IsDate(sDateModif) Then
    MsgBox "La date saisie est incorrecte", vbCritical
Else
    sDateModif = Format(sDateModif, "yyyy-mm-dd")
End If

Pour appeler la date saisie dans votre requête

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
sql = "SELECT [PrénomParticipant], [NomParticipant], [Ecole], [CS], [DateModif], [AllDateProjet]" _
& " FROM TbInscriptionsDP" _
& " WHERE CodeProjet = '" & ScodeProjet & "'" _
& " AND DateModif = #" & sDateModif & "#"

[LiseUEMPT]

Merci Hyperion13 pour vos réponses
malheureusement le problème s'est aggravé. Maintenant l'ouverture du recordset ne se fait plus :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set rst = CurrentDb.OpenRecordset(sql)

J'ai fait des tests pas à pas et à la ligne ci-haut plus rien ne se fait, si je bloque la dernière partie de l'instruction:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

& " AND DateModif = '" & sDateModif & "'"

je reviens à la situation précédente, il y a toutes les fiches.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
 
Voici le code que j'ai testé pour le format String et j'ai aussi testé pour le format date et j'ai le même problème, aucune ouverture du recordset.
 
'TEST DateModif sur STRING
Dim ScodeProjet, lCodeProjet As String
Dim MESSAGE, Msg, Style, Title, Reponse, Default
Dim Fichier As String
'------------
Dim sql, sql1 As String
Dim DDateModif, resultatDDat, resultatDDateModif As Date
Dim sDateModif, resultatLCode, resultatNomP, resultatPNomP, resultatEkol, resultatCS As String
Dim resultatAllDat1, resultatDat2, resultatDat3, resultatDat4, resultatDat5, resultatDat6 As String
Dim resultatsDateModif, resultatsDat  As String
Dim Paramètre, NomFichier
 
Sub AccProjet1DPbis2a()   '-'-'-'- 3oct2021
On Error GoTo AccProjet1DPBis2a_err
Fichier = "AccordAllocationProjetDP"  '
 
ChDir "C:\Users\" & Environ$("UserName") & "\OneDrive - MEES\PartageMtl\Listes\Allocation\"
 
ScodeProjet = InputBox("Saisissez le code projet  :", "Accord allocation - code de projet.", Default)
sDateModif = InputBox("Inscrire la date de modification:", "Format de la date : aaaa-mm-jj", Default)
 
Call NomPDF_AccordBisa
'---------------
Paramètre = ScodeProjet & " - " & resultatCS & "-" & resultatEkol & "- " & resultatNomP & ", " & resultatPNomP & " - Allocation P1 " & resultatAllDat1 & "  " & resultatsDateModif     ' Extraire avec la date de modification
NomFichier = ScodeProjet & " - " & resultatCS & "-" & resultatEkol & "- " & resultatNomP & ", " & resultatPNomP & " - Allocation P1 " & resultatAllDat1 & "  " & resultatsDateModif  'sauve avec la date de AllDateProjet
 
MsgBox "resultatsDateModif  " & resultatsDateModif
 
DoCmd.OutputTo acOutputReport, Fichier, acFormatPDF, Paramètre & ".pdf", False, "", , acExportQualityPrint
 
MsgBox "Répertoire <Listes\Allocation> = " & NomFichier & ".pdf", vbInformation, "Sauvegarde"
 
DoCmd.OpenReport Fichier, acViewPreview
Call ImpressionDirecte
 
MsgBox "Attention, si vous avez créé plusieurs allocations la même journée, il se peut qu'il y ait plusieurs formulaires dans le fichier sauvegardé", vbCritical
AccProjet1DPBis2a_err: Exit Sub
End Sub
 
 
'0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-0-
Sub NomPDF_AccordBisa()
Dim rst As DAO.Recordset
'sql = "SELECT [PrénomParticipant], [NomParticipant], [Ecole], [CS], [DateModif], [AllDateProjet] FROM TbInscriptionsDP WHERE CodeProjet = '" & ScodeProjet & "'" ' AND DateModif = '" & SDateModif & "'"
'sql = "SELECT [PrénomParticipant], [NomParticipant], [Ecole], [CS], [DateModif], [AllDateProjet] FROM TbInscriptionsDP WHERE CodeProjet = '" & ScodeProjet & "'" And DateModif = " & DDateModif & "
 
 
sql = "SELECT [PrénomParticipant], [NomParticipant], [Ecole], [CS], [DateModif], [AllDateProjet]" _
& " FROM TbInscriptionsDP" _
& " WHERE CodeProjet = '" & ScodeProjet & "'" _
& " AND DateModif = '" & sDateModif & "'"
 
Set rst = CurrentDb.OpenRecordset(sql)
resultatPNomP = rst.Fields("PrénomParticipant").Value
resultatNomP = rst.Fields("NomParticipant").Value
resultatEkol = rst.Fields("Ecole").Value
resultatCS = rst.Fields("CS").Value
resultatAllDat1 = rst.Fields("AllDateProjet").Value
MsgBox "resultatAllDat1   " & resultatAllDat1
 
resultatsDat = rst.Fields("DateModif").Value
MsgBox "resultatsDat  " & resultatsDat
 
resultatsDateModif = Left(rst.Fields("DateModif").Value, 10)
MsgBox "resultatsDateModif  " & resultatsDateModif
End Sub

J'ai aussi testé en créant un champ DateModif1 au format texte, c'est toujours le même problème, ça enregistre toutes les fiches.
En utilisant ce même test DateModif1 au format texte: pour avoir le bon résultat de rapport, j'ai inscrit dans la requête un critère qui demande la date de modification, là j'ai le bon résultat.
Cependant lors de l'affichage du rapport dans ACCESS

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

DoCmd.OpenReport Fichier, acViewPreview

il me redemande la date de modification, ça fait que cette date doit être inscrite 2 fois, soit lors de l'enregistrement du fichier au format PDF et lors de l'affichage de ce dernier. C'est cela que je veux éviter. Y aurait-il un moyen...

J'ai exécuté la requête originale et demandé une autre date, je vois que DateModif est inscrite date et heure, et ça affiche toutes les fiches.

Toutes les solutions données améliorent grandement mon code mais ça ne règlent malheureusement pas le problème. Je suis bien découragée.

[hyperion13]

Re,
Je viens de faire un essai sur la mythique bdd Comptoir ou NorhWind avec le bout de code que je vous ai proposé et il fonctionne.
Je travaille avec les paramètres régionaux France(France)
- date_fact est au format Date (jj/mm/aaaa) dans la tbl
- inputbox me permet de saisir une date valide (jj/mm/aaaa)
- la date saisie permet ensuite de filtrer un rpt et de le convertir au format *.pdf

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub btnPrintRpt_Click()
Dim strFilepath As String, strFolder As String, strFileName As String, strWhere As String, rptName As String
 
strFilepath = CurrentProject.Path
strFolder = "\report\"
strFilepath = strFilepath & strFolder
 
StrDate = Eval("InputBox(""saisir la date de modification:"",""Format de la date : jj/mm/aaaa"", date())")
If Not IsDate(StrDate) Then
    MsgBox "La date saisie est incorrecte", vbCritical
Else
    StrDate = Format(StrDate, "dd/mm/yyyy")
    Debug.Print StrDate
End If
 
rptName = "rpt_tblFacture"
strFileName = strFilepath & Format(StrDate, "yyyy-mm-dd") & ".pdf"
strWhere = "[date_fact] = #" & StrDate & "#"
 
DoCmd.OpenReport rptName, acViewPreview, , strWhere
DoCmd.OutputTo acOutputReport, rptName, acFormatPDF, strFileName
DoCmd.Close acReport, rptName, acSaveNo
End Sub