Discussion :

[robin des bulles]

salut à tous

cela fait 2 semaine que je suis sur un programme qui simplifira la facturation
j'ai dejà eu beaucoup d'erreur que j'ai reussi a solutionner grace a la faq ou au forum mais là
je ne comprend pas trop l'erreur car j'ai du mal avec les recordset

Access me renvoie l'erreur du titre sur la ligne en rouge :
note : les retour à la ligne ds les requete ne st pas ds mon code.

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
Private Sub bordereau()
'Connection à la base courante :
    'On déclare l'objet connexion ...
    Dim cnCliniqueOuverte As ADODB.Connection
    '... et on lui indique qu'elle correspond à l'application en cours
    Set cnCliniqueOuverte = Application.CurrentProject.Connection
'Creation des recordset
    'On déclare les recorset, ...
    Dim rsBordereau As New ADODB.Recordset
    Dim rsNbLigneParPatient As New ADODB.Recordset
    Dim rsNbLigneTotal As New ADODB.Recordset
    '... on définie les requete, ...
    Dim rqSQL1 As String
    Dim rqSQL2 As String
    Dim rqSQL3 As String
    '... on les complete, ...
    rqSQL1 = "SELECT Patient.NumSSPatient, NomPatient, PrenomPatient, Praticien.NumADELI, NomPraticien, 
PrenonPraticien, TauxPriseEnCharge, MofifActe1, ModifActe2, Acte.CodeActe, TarifActe, DateActe
              FROM Praticien INNER JOIN (Patient INNER JOIN (Acte INNER JOIN Effectuer ON 
Acte.CodeActe = Effectuer.CodeActe) ON Patient.NumSSPatient = Effectuer.NumSSPatient)
ON Praticien.NumADELI = Effectuer.NumADELI
              WHERE Effectuer.DateActe >= [Formulaires]![FormBordereau]![TxtDateDebut]
              AND Effectuer.DateActe <= [Formulaires]![FormBordereau]![TxtDateFin]
              ORDER BY NomPraticien, PrenonPraticien;"
    rqSQL2 = "SELECT Count(*) AS NbLignePatient
              FROM [rsBordereau]
              GROUP BY [NumADELI];"
    rqSQL3 = "SELECT Count(*) AS NbLigneTotal
              FROM [rsNbLigneParPatient];"
    '... puis on les execute et stocke
    Set rsBordereau = cnCliniqueOuverte.Execute(rqSQL1)
    Set rsNbLigneParPatient = cnCliniqueOuverte.Execute(rqSQL2)
    Set rsNbLigneTotal = cnCliniqueOuverte.Execute(rqSQL3)
End Sub

pdt que j'y suis j'en profite pour mettre la partie qui communique avec access
car j'ai 'impression que ca ne marchera pas du 1er coup dc si vous voyez une incohérance flagrante que j'aurai pas vu ...

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
Private Sub CmdOk_Click()
    'On utilise des recordset :
    bordereau
'Eploitation des recordset
    'On vérifie qu'il retourne au moin une ligne :
    If rsBordereau.EOF Then
        'Si au moins un tuple existe ...
            'On vérifie que le bordereau (NomFichier) se trouve bien _
            dans le dossier (CheminDossier) ...
            '   With Application.FileSearch
            '       .lookin = CheminDossier
            '       .FileName = NomFichier
            '       .filetype = msoFileTypeAllFiles
            '       .Searchsubfolders = True
            '        If .Execute Then
                        'Si le fichier est là ... _
                        ... on ouvre le dit fichier :
                        'on déclare les objets, ...
                        Dim appexcel As Excel.Application
                        Dim wbexcel As Excel.Workbook
                        '... on appele le fichier excel ...
                        Set appexcel = CreateObject("Excel.Application")
                        appexcel.Visible = True
                        Set wbexcel = appexcel.Workbooks.Open("z:\bordereau.xls")
                        '... on Appele la feuille correspondante :
                        appexcel.Sheets("Bordereau").Select
                        '... quelques traitements s'imposent ...
                        'Ajout de bloc de 3 lignes en fonction du NbLigneTotal ...
                        i = 1
                        Do Until rsNbLigneTotal.EOF And i = rsNbLigneTotal![NbLigneTotal]
                            Range("A" & 16 + (i - 1) * 3 & ":M" & 18 + (i - 1) * 3).Select
                            Selection.Copy
                            Range("A" & 19 + (i - 1) * 3 & ":M" & 21 + (i - 1) * 3).Select
                            Selection.Insert Shift:=xlDown
                            '... insertion du n° d'ordre ...
                            xlSheet.Cells(13 + (i - 1) * 3, 1) = i
                            '... insertion des données ds les lignes ...
                            j = 0
                            Do Until rsNbLigneParPatient.EOF And j = rsNbLigneParPatient![NbLignePatient] - 1
                                appexcel.Cells(16 + j + (i - 1) * 3, 2) = rsBordereau![NomPatient]
                                appexcel.Cells(16 + j + (i - 1) * 3, 3) = rsBordereau![PrenomPatient]
                                appexcel.Cells(16 + j + (i - 1) * 3, 4) = rsBordereau![NumSSPatientPatient]
                                appexcel.Cells(16 + j + (i - 1) * 3, 5) = rsBordereau![NomPraticien]
                                appexcel.Cells(16 + j + (i - 1) * 3, 6) = rsBordereau![PrenomPraticien]
                                appexcel.Cells(16 + j + (i - 1) * 3, 7) = rsBordereau![NomPatient]
                                appexcel.Cells(16 + j + (i - 1) * 3, 8) = rsBordereau![TauxPriseEnCahrge]
                                appexcel.Cells(16 + j + (i - 1) * 3, 3) = rsBordereau![DateActe]
                                If rsBordereau![ModifActe1] = "" And rsBordereau![ModifActe2] = "" Then
                                    appexcel.Cells(16 + j + (i - 1) * 3, 4) = rsBordereau![CodeActe]
                                Else
                                    If rsBordereau![ModifActe1] = "" Or rsBordereau![ModifActe2] = "" Then
                                        If rsBordereau![ModifActe1] = "" Then
                                            appexcel.Cells(16 + j + (i - 1) * 3, 4) =
rsBordereau![CodeActe] & "  " & rsBordereau![ModifActe2]
                                        Else
                                            appexcel.Cells(16 + j + (i - 1) * 3, 4) =
rsBordereau![CodeActe] & "  " & rsBordereau![ModifActe1]
                                        End If
                                    Else
                                        appexcel.Cells(16 + j + (i - 1) * 3, 4) =
rsBordereau![CodeActe] & "  " & rsBordereau![ModifActe1] & " + " & rsBordereau![ModifActe2]
                                    End If
                                End If
                                '... incrémentation des enregistrement ...
                                rsBordereau.MoveNext
                                j = j + 1
                            Loop                            rsNbLigneParPatient.MoveNext
                            i = i + 1
                        Loop
                        'On peut alors fermer le formulaire courant :
                        DoCmd.Close
            '        Else
            '            'Si le fichier n'est pas là :
            '            MsgBox "Le fichier " & NomFichier & " est introuvable !" _
            '               & vbCrLf & " Vérifier que " & CheminDossier & " est le bon chemin d'accès." _
            '               & vbCrLf & " Si besoin changer le chemin d'accès dans les paramètres" _
            '               & vbCrLf & " ou contactez votre administrateur systeme."
            '        End If
            '   End With
    Else
        'S'il n'y a aucune ligne renvoyée on prévient l'utilsateur ...
        MsgBox "L'intervalle des dates sélectionnées ne renvoie aucunes lignes !"
        '... on ferme le formulaire ...
        DoCmd.Close
        '... et on revient à l'acceuil :
        DoCmd.OpenForm "Acceuil", acNormal
    End If
End Sub

merci d'avance

[robin des bulles]

en fait il suffisait de changer

Code :

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

1
2
WHERE Effectuer.DateActe >= [Formulaires]![FormBordereau]![TxtDateDebut]
              AND Effectuer.DateActe <= [Formulaires]![FormBordereau]![TxtDateFin]

par

Code :

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

1
2
 WHERE Effectuer.DateActe >= " & TxtDateDebut &
 " AND Effectuer.DateActe <= " & TxtDateFin & " ORDER BY

mais mantenant c'est le recordset 2 qui n'est pas content !

Code :

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

FROM [rsBordereau]

EDIT : merci Robin des Bules