Ouverture d'une requête Access via VBA Excel

Version imprimable

1 pièce(s) jointe(s)

Bonjour,

Je vais essayer d'être la plus claire possible.
J'ai crée une basse de données de pointage de colis qui comporte 4 tables toutes les 4 liées entre elle.
Avec ces 4 tables, j'ai crée plusieurs requête afin d’obtenir des taux de pointages.
Jusque là tout va bien.

J'ai crée un fichier Excel qui me permettra de stocker tous ces taux de pointages afin de faire des analyses.
Pour 3 de mes 4 requêtes, tout se passe bien sauf pour une seule.
Je n'arrive pas à trouver le problème.

Voici la requête qui bug :
Code:

1 2 3 4 5 6 7 8 9 10 'Taux Mode Requete = "SELECT Expedition.Date_PEC, Sum(Expedition!Colis) AS Somme_Colis, Sum(STV_R!Nbre_Colis_non_lus) AS Somme_Colis_non_lus, ((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux, Expedition.Mode" Requete = Requete & " FROM Expedition LEFT JOIN STV_R ON (Expedition.Date_PEC = STV_R.Date_PEC) AND (Expedition.CD = STV_R.CD) AND (Expedition.Recep = STV_R.Recep)" Requete = Requete & " GROUP BY Expedition.Date_PEC, Expedition.Mode" Requete = Requete & " HAVING (((Expedition.Date_PEC)=" & DA & "));" With Rs .CursorLocation = adUseClient .Open Requete, Connexion, adOpenDynamic, adLockOptimistic End With
Voici tout le code si ça peut aider à déterminer le problème :
Pièce jointe 171771

Merci d'avance pour votre aide

Julie

Bonjour,
d'abord, plusieurs chose,
ADO c'est un connecteur de base de données universelle! on ne peut pas utiliser les étiquettes pour faire de opération arithmétique :((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux, Expedition.Mode ,

la close HAVING permet de filtrer les données liées au regroupement HAVING Sum(Expedition.Colis)>10 tu l'utilise comme une close where ça fonctionne mais ça oblige la requête à faire un regroupement sur la totalité de la table et non sur la requête déjà filtré par le where. Where Expedition.Date_PEC=" & DA,

tu concatène ta variable Requete sens espace de séparation entre la fin de ligne en le début de l'autre
Code:

1 2 Requete = "SELECT....AS Taux, Expedition.Mode" Requete = Requete & " FROM ....AND (Expedition.Recep = STV_R.Recep)"
on est pas dans Excel Sum(Expedition!Colis)
Code:

1 2 3 4 5 Requete ="SELECT Somme_Colis,Somme_Colis_non_lus, ((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux from (" Requete = Requete & "SELECT Expedition.Date_PEC, Sum(Expedition.Colis) AS Somme_Colis, Sum(STV_R.Nbre_Colis_non_lus) AS Somme_Colis_non_lus " Requete = Requete & " FROM Expedition LEFT JOIN STV_R ON (Expedition.Recep = STV_R.Recep) AND (Expedition.CD = STV_R.CD) AND (Expedition.Date_PEC = STV_R.Date_PEC) " Requete = Requete & " Where Expedition.Date_PEC=" & DA & " " Requete = Requete & " GROUP BY Expedition.Date_PEC);"

1 pièce(s) jointe(s)

Bonjour Rdurupt,

Tout d'abord, merci de ta rapidité.
En fait, je me suis trompée, le Taux Mode fonctionne bien.

C'est celui ci qui ne fonctionne pas

Code:

1
2
3
4
5
6
7
8
9
10
'Taux Zone
Requete = "SELECT Expedition.Date_PEC, Sum(Expedition!Colis) AS Somme_Colis, Sum(STV_R!Nbre_Colis_non_lus) AS Somme_Colis_non_lus, ((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux, Zone_Rechargement.Zone, Equipe.Equipe"
Requete = Requete & " FROM ((Expedition LEFT JOIN STV_R ON (Expedition.Date_PEC = STV_R.Date_PEC) AND (Expedition.CD = STV_R.CD) AND (Expedition.Recep = STV_R.Recep)) LEFT JOIN Zone_Rechargement ON (Expedition.CD = Zone_Rechargement.CD) AND (Expedition.Code_traction = Zone_Rechargement.Code_traction)) LEFT JOIN Equipe ON Expedition.Code_apporteur = Equipe.Code_apporteur"
Requete = Requete & " GROUP BY Expedition.Date_PEC, Zone_Rechargement.Zone, Equipe.Equipe"
Requete = Requete & " HAVING (((Expedition.Date_PEC)=" & DA & ") AND ((Equipe.Equipe) Is Null));"
 
    With Rs
        .CursorLocation = adUseClient
        .Open Requete, Connexion, adOpenDynamic, adLockOptimistic
    End With

J'essaie de faire comme tu as expliqué pour le Taux Mode mais je dois mal faire quelque chose.
Quand j'ai essayé ton code pour le Taux Mode, j'obtenais un taux "global" et non un taux par Mode (j'ai normalement un taux mode en D (pour départ) et un taux mode en R (pour réex).

Pour mon taux Zone, je cherche à avoir la même chose : tous mes taux de pointage par Zone (zone allant de Z1 à Z6).
D'où cette requête.

Merci d'avance pour ton aide précieuse.

Julie

Si ça peut aider, voici comment est construite ma requête sous access et voici le SQL de cette requête :

Code:

1
2
3
4
SELECT Expedition.Date_PEC, Sum(Expedition!Colis) AS Somme_Colis, Sum(STV_R!Nbre_Colis_non_lus) AS Somme_Colis_non_lus, ((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux, Zone_Rechargement.Zone, Equipe.Equipe
FROM ((Expedition LEFT JOIN STV_R ON (Expedition.Recep = STV_R.Recep) AND (Expedition.CD = STV_R.CD) AND (Expedition.Date_PEC = STV_R.Date_PEC)) LEFT JOIN Zone_Rechargement ON (Expedition.Code_traction = Zone_Rechargement.Code_traction) AND (Expedition.CD = Zone_Rechargement.CD)) LEFT JOIN Equipe ON Expedition.Code_apporteur = Equipe.Code_apporteur
GROUP BY Expedition.Date_PEC, Zone_Rechargement.Zone, Equipe.Equipe
HAVING (((Expedition.Date_PEC)=20150225) AND ((Equipe.Equipe) Is Null));

Pièce jointe 171792

Pourtant si ta requête tourne en l'état dans Access en passant en mode sql dans Access tu peux récupérer les scripte et le coller dans vba!
R

Code:

1
2
3
4
equete = "SELECT Expedition.Date_PEC, Sum(Expedition.Colis) AS Somme_Colis, Sum(STV_R.Nbre_Colis_non_lus) AS Somme_Colis_non_lus, ((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux, Zone_Rechargement.Zone, Equipe.Equipe"
Requete = Requete & " FROM ((Expedition LEFT JOIN STV_R ON (Expedition.Date_PEC = STV_R.Date_PEC) AND (Expedition.CD = STV_R.CD) AND (Expedition.Recep = STV_R.Recep)) LEFT JOIN Zone_Rechargement ON (Expedition.CD = Zone_Rechargement.CD) AND (Expedition.Code_traction = Zone_Rechargement.Code_traction)) LEFT JOIN Equipe ON Expedition.Code_apporteur = Equipe.Code_apporteur"
Requete = Requete & " WHERE Expedition.Date_PEC=" & DA & " AND Equipe.Equipe Is Null"
Requete = Requete & " GROUP BY Expedition.Date_PEC, Zone_Rechargement.Zone, Equipe.Equipe"

16/03/2015, 12h16
hoodoo

Malheureusement, la macro bug sur cette ligne

Code:

.Open Requete, Connexion, adOpenDynamic, adLockOptimistic

Le message d'erreur est le suivant :

Citation:

Erreur d'exécution '_214767259 (80004005)' :

La méthode 'Open' de l'objet '_Recordset' a échoué

Je désespère, tout le reste de la macro fonction (j'ai essayé sans cette requête, tout passe. Il ne me manque plus que cette requête pour finir et enfin pouvoir commencer à bosser sur mon analyse :/

Code:

1
2
3
4
5
6
7
8
9
10
11
Requete = "SELECT Expedition.Date_PEC, Sum(Expedition.Colis) AS Somme_Colis, Sum(STV_R.Nbre_Colis_non_lus) AS Somme_Colis_non_lus, ((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux, Zone_Rechargement.Zone, Equipe.Equipe"
Requete = Requete & " FROM ((Expedition LEFT JOIN STV_R ON (Expedition.Date_PEC = STV_R.Date_PEC) AND (Expedition.CD = STV_R.CD) AND (Expedition.Recep = STV_R.Recep)) LEFT JOIN Zone_Rechargement ON (Expedition.CD = Zone_Rechargement.CD) AND (Expedition.Code_traction = Zone_Rechargement.Code_traction)) LEFT JOIN Equipe ON Expedition.Code_apporteur = Equipe.Code_apporteur"
Requete = Requete & " WHERE Expedition.Date_PEC=" & DA & " AND Equipe.Equipe Is Null"
Requete = Requete & " GROUP BY Expedition.Date_PEC, Zone_Rechargement.Zone, Equipe.Equipe"
 
 Rs.close
 set  Rs =New ADODB.Recordset
    With Rs
        .CursorLocation = adUseClient
        .Open Requete, Connexion, adOpenDynamic, adLockOptimistic
    End With

16/03/2015, 12h32
hoodoo

Ca bug sur le Rs.Close

Citation:

Erreur d'exécution '3704' :

Cette opération n'est pas autorisé si l'objet est fermé

Comprends:
il faut créer une instance: set RS= New ADODB.Recordset
Ouvrir ta requête : Rs.open
Fermer ta requête :Rs.close
Retirer l'instance : Set Rs=Nothing

Code:

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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
Sub PNT_R()
Application.ScreenUpdating = False
DA = Range("F12").Value
Sheets("TX_Global_Zone").Select
 
LIGNE_DA = Cells.Find(what:=DA, After:=ActiveCell, LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False).Row
 
Dim Connexion As New ADODB.Connection
Dim Rs As New ADODB.Recordset
Dim CheminBase As String
Dim CompteChamps As Long
Dim Requete As String
Dim NomTable As String
 
'Taux Global
CheminBase = "N:\Calexpress\13 - METHODES\13.2 Public\13.2.3 Divers\97 - Bases de données\POINTAGE\Taux_pointage.mdb"
Connexion.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & CheminBase & ";"
 
Requete = "SELECT Expedition.Date_PEC, Sum(Expedition!Colis) AS Somme_Colis, Sum(STV_R!Nbre_Colis_non_lus) AS Somme_Colis_non_lus, ((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux"
Requete = Requete & " FROM Expedition LEFT JOIN STV_R ON (Expedition.Recep = STV_R.Recep) AND (Expedition.CD = STV_R.CD) AND (Expedition.Date_PEC = STV_R.Date_PEC)"
Requete = Requete & " GROUP BY Expedition.Date_PEC"
Requete = Requete & " HAVING (((Expedition.Date_PEC)=" & DA & "));"
 
    With Rs
        .CursorLocation = adUseClient
        .Open Requete, Connexion, adOpenDynamic, adLockOptimistic
    End With
 
Range("B" & LIGNE_DA) = Rs.Fields("Somme_Colis")
Range("C" & LIGNE_DA) = Rs.Fields("Somme_Colis_non_lus")
Range("D" & LIGNE_DA) = Rs.Fields("Taux")
Rs.close
Set Rs = Nothing
set Rs = New ADODB.Recordset
'Taux Mode
Requete = "SELECT Expedition.Date_PEC, Sum(Expedition!Colis) AS Somme_Colis, Sum(STV_R!Nbre_Colis_non_lus) AS Somme_Colis_non_lus, ((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux, Expedition.Mode"
Requete = Requete & " FROM Expedition LEFT JOIN STV_R ON (Expedition.Date_PEC = STV_R.Date_PEC) AND (Expedition.CD = STV_R.CD) AND (Expedition.Recep = STV_R.Recep)"
Requete = Requete & " GROUP BY Expedition.Date_PEC, Expedition.Mode"
Requete = Requete & " HAVING (((Expedition.Date_PEC)=" & DA & "));"
 
    With Rs
        .CursorLocation = adUseClient
        .Open Requete, Connexion, adOpenDynamic, adLockOptimistic
    End With
 
Do Until Rs.Fields("Mode").Value = "D"
Rs.MoveNext
Loop
Range("E" & LIGNE_DA) = Rs.Fields("Taux")
Do Until Rs.Fields("Mode").Value = "R"
Rs.MoveNext
Loop
Range("F" & LIGNE_DA) = Rs.Fields("Taux")
 
Rs.close
Set Rs = Nothing
set Rs = New ADODB.Recordset
 
'Taux Zone
Requete = "SELECT Expedition.Date_PEC, Sum(Expedition!Colis) AS Somme_Colis, Sum(STV_R!Nbre_Colis_non_lus) AS Somme_Colis_non_lus, ((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux, Zone_Rechargement.Zone, Equipe.Equipe"
Requete = Requete & " FROM ((Expedition LEFT JOIN STV_R ON (Expedition.Date_PEC = STV_R.Date_PEC) AND (Expedition.CD = STV_R.CD) AND (Expedition.Recep = STV_R.Recep)) LEFT JOIN Zone_Rechargement ON (Expedition.CD = Zone_Rechargement.CD) AND (Expedition.Code_traction = Zone_Rechargement.Code_traction)) LEFT JOIN Equipe ON Expedition.Code_apporteur = Equipe.Code_apporteur"
Requete = Requete & " GROUP BY Expedition.Date_PEC, Zone_Rechargement.Zone, Equipe.Equipe"
Requete = Requete & " HAVING (((Expedition.Date_PEC)=" & DA & ") AND ((Equipe.Equipe) Is Null));"
 
    With Rs
        .CursorLocation = adUseClient
        .Open Requete, Connexion, adOpenDynamic, adLockOptimistic
    End With
 
Do Until Rs.Fields("Zone").Value = "Z1"
Rs.MoveNext
Loop
Range("G" & LIGNE_DA) = Rs.Fields("Taux")
Do Until Rs.Fields("Zone").Value = "Z2"
Rs.MoveNext
Loop
Range("H" & LIGNE_DA) = Rs.Fields("Taux")
Do Until Rs.Fields("Zone").Value = "Z3"
Rs.MoveNext
Loop
Range("I" & LIGNE_DA) = Rs.Fields("Taux")
Do Until Rs.Fields("Zone").Value = "Z4"
Rs.MoveNext
Loop
Range("J" & LIGNE_DA) = Rs.Fields("Taux")
Do Until Rs.Fields("Zone").Value = "Z5"
Rs.MoveNext
Loop
Range("K" & LIGNE_DA) = Rs.Fields("Taux")
Do Until Rs.Fields("Zone").Value = "Z6"
Rs.MoveNext
Loop
Range("L" & LIGNE_DA) = Rs.Fields("Taux")
 
Rs.close
Set Rs = Nothing
set Rs = New ADODB.Recordset
 
'Taux Equipe Nuit
Requete = "SELECT Expedition.Date_PEC, Sum(Expedition!Colis) AS Somme_Colis, Sum(STV_R!Nbre_Colis_non_lus) AS Somme_Colis_non_lus, ((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux, Equipe.Equipe"
Requete = Requete & " FROM (Expedition LEFT JOIN Equipe ON Expedition.Code_apporteur = Equipe.Code_apporteur) LEFT JOIN STV_R ON (Expedition.Recep = STV_R.Recep) AND (Expedition.CD = STV_R.CD) AND (Expedition.Date_PEC = STV_R.Date_PEC)"
Requete = Requete & " GROUP BY Expedition.Date_PEC, Equipe.Equipe"
Requete = Requete & " HAVING (((Expedition.Date_PEC)=20150225) AND ((Equipe.Equipe)='N'));"
 
    With Rs
        .CursorLocation = adUseClient
        .Open Requete, Connexion, adOpenDynamic, adLockOptimistic
    End With
 
Range("M" & LIGNE_DA) = Rs.Fields("Taux")
 
Rs.close
Set Rs = Nothing
set Rs = New ADODB.Recordset
 
'Taux CD
Requete = "SELECT Expedition.Date_PEC, Sum(Expedition!Colis) AS Somme_Colis, Sum(STV_R!Nbre_Colis_non_lus) AS Somme_Colis_non_lus, ((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux, Expedition.CD"
Requete = Requete & " FROM Expedition LEFT JOIN STV_R ON (Expedition.Date_PEC = STV_R.Date_PEC) AND (Expedition.CD = STV_R.CD) AND (Expedition.Recep = STV_R.Recep)"
Requete = Requete & " GROUP BY Expedition.Date_PEC, Expedition.CD"
Requete = Requete & " HAVING (((Expedition.Date_PEC)=20150225));"
 
 
    With Rs
        .CursorLocation = adUseClient
        .Open Requete, Connexion, adOpenDynamic, adLockOptimistic
    End With
 
Sheets("REQUETE").Range("A1").CopyFromRecordset Rs
 
Sheets("REQUETE").Select
lg = Range("A1").End(xlDown).Row
For i = 1 To lg
    CD = Range("B" & i).Value
    TX = Range("C" & i).Value
    Sheets("TX_CD").Select
        Set PlageDeRecherche = ActiveSheet.Rows(1)
        Set Trouve = PlageDeRecherche.Cells.Find(what:=CD, LookAt:=xlWhole)
        If Trouve Is Nothing Then
            GoTo suite
        Else
            COLONNE = Trouve.Column
            Set MaPlage = Columns(COLONNE).Rows(LIGNE_DA)
            MaPlage.Value = TX
            If MaPlage.Value = "" Then
                MaPlage.Value = 100
            End If
        End If
'vidage des variables
Set PlageDeRecherche = Nothing
Set Trouve = Nothing
 
suite:
    Sheets("REQUETE").Select
Rs.close
Set Rs = Nothing
Set Connexion = Nothing
 
End Sub

16/03/2015, 13h36
hoodoo

Malheureusement, j'ai toujours ce message d'erreur sur la requête Taux Zone :

Citation:

Erreur d'exécution '_214767259 (80004005)' :

La méthode 'Open' de l'objet '_Recordset' a échoué
16/03/2015, 13h47
Invité

1 pièce(s) jointe(s)

on est bien d'accord, si tu click su la grille en dessous de fichier ta requête fonctionne?
16/03/2015, 13h54
hoodoo

1 pièce(s) jointe(s)

Oui oui

Pièce jointe 171824

Petite précision, la zone sans résultat, c'est une zone que je ne vais pas analyser de suite.
Et pour l'équipe, seul l'équipe de soir entre dans mes stats donc je filtre sur l'équipe vide (équipe du soir). Seul l'équipe nuit est dans ma table équipe.

Bonjour,
je t'invite à tester comme ça!

Code:

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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
Function OpenRecordSet(Sql As String, Con As Object) As Object
Set OpenRecordSet = CreateObject("adodb.reordset")
 With OpenRecordSet
        .CursorLocation = adUseClient
        .Open Sql, Con, adOpenDynamic, adLockOptimistic
    End With
End Function
Sub PNT_R()
Application.ScreenUpdating = False
DA = Range("F12").Value
Sheets("TX_Global_Zone").Select
 
LIGNE_DA = Cells.Find(what:=DA, After:=ActiveCell, LookIn:=xlFormulas, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False).Row
 
Dim Connexion As New ADODB.Connection
Dim Rs As New ADODB.Recordset
Dim CheminBase As String
Dim CompteChamps As Long
Dim Requete As String
Dim NomTable As String
 
'Taux Global
CheminBase = "N:\Calexpress\13 - METHODES\13.2 Public\13.2.3 Divers\97 - Bases de données\POINTAGE\Taux_pointage.mdb"
Connexion.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & CheminBase & ";"
 
Requete = "SELECT Expedition.Date_PEC, Sum(Expedition!Colis) AS Somme_Colis, Sum(STV_R!Nbre_Colis_non_lus) AS Somme_Colis_non_lus, ((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux"
Requete = Requete & " FROM Expedition LEFT JOIN STV_R ON (Expedition.Recep = STV_R.Recep) AND (Expedition.CD = STV_R.CD) AND (Expedition.Date_PEC = STV_R.Date_PEC)"
Requete = Requete & " GROUP BY Expedition.Date_PEC"
Requete = Requete & " HAVING (((Expedition.Date_PEC)=" & DA & "));"
 
  Set Rs = OpenRecordSet(Requete, Connexion)
 
Range("B" & LIGNE_DA) = Rs.Fields("Somme_Colis")
Range("C" & LIGNE_DA) = Rs.Fields("Somme_Colis_non_lus")
Range("D" & LIGNE_DA) = Rs.Fields("Taux")
Rs.Close
Set Rs = Nothing
'Taux Mode
Requete = "SELECT Expedition.Date_PEC, Sum(Expedition!Colis) AS Somme_Colis, Sum(STV_R!Nbre_Colis_non_lus) AS Somme_Colis_non_lus, ((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux, Expedition.Mode"
Requete = Requete & " FROM Expedition LEFT JOIN STV_R ON (Expedition.Date_PEC = STV_R.Date_PEC) AND (Expedition.CD = STV_R.CD) AND (Expedition.Recep = STV_R.Recep)"
Requete = Requete & " GROUP BY Expedition.Date_PEC, Expedition.Mode"
Requete = Requete & " HAVING (((Expedition.Date_PEC)=" & DA & "));"
 Set Rs = OpenRecordSet(Requete, Connexion)
 
Do Until Rs.Fields("Mode").Value = "D"
Rs.MoveNext
Loop
Range("E" & LIGNE_DA) = Rs.Fields("Taux")
Do Until Rs.Fields("Mode").Value = "R"
Rs.MoveNext
Loop
Range("F" & LIGNE_DA) = Rs.Fields("Taux")
 
Rs.Close
Set Rs = Nothing
 
'Taux Zone
Requete = "SELECT Expedition.Date_PEC, Sum(Expedition!Colis) AS Somme_Colis, Sum(STV_R!Nbre_Colis_non_lus) AS Somme_Colis_non_lus, ((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux, Zone_Rechargement.Zone, Equipe.Equipe"
Requete = Requete & " FROM ((Expedition LEFT JOIN STV_R ON (Expedition.Date_PEC = STV_R.Date_PEC) AND (Expedition.CD = STV_R.CD) AND (Expedition.Recep = STV_R.Recep)) LEFT JOIN Zone_Rechargement ON (Expedition.CD = Zone_Rechargement.CD) AND (Expedition.Code_traction = Zone_Rechargement.Code_traction)) LEFT JOIN Equipe ON Expedition.Code_apporteur = Equipe.Code_apporteur"
Requete = Requete & " GROUP BY Expedition.Date_PEC, Zone_Rechargement.Zone, Equipe.Equipe"
Requete = Requete & " HAVING (((Expedition.Date_PEC)=" & DA & ") AND ((Equipe.Equipe) Is Null));"
 Set Rs = OpenRecordSet(Requete, Connexion)
 
Do Until Rs.Fields("Zone").Value = "Z1"
Rs.MoveNext
Loop
Range("G" & LIGNE_DA) = Rs.Fields("Taux")
Do Until Rs.Fields("Zone").Value = "Z2"
Rs.MoveNext
Loop
Range("H" & LIGNE_DA) = Rs.Fields("Taux")
Do Until Rs.Fields("Zone").Value = "Z3"
Rs.MoveNext
Loop
Range("I" & LIGNE_DA) = Rs.Fields("Taux")
Do Until Rs.Fields("Zone").Value = "Z4"
Rs.MoveNext
Loop
Range("J" & LIGNE_DA) = Rs.Fields("Taux")
Do Until Rs.Fields("Zone").Value = "Z5"
Rs.MoveNext
Loop
Range("K" & LIGNE_DA) = Rs.Fields("Taux")
Do Until Rs.Fields("Zone").Value = "Z6"
Rs.MoveNext
Loop
Range("L" & LIGNE_DA) = Rs.Fields("Taux")
 
Rs.Close
Set Rs = Nothing
Set Rs = New ADODB.Recordset
 
'Taux Equipe Nuit
Requete = "SELECT Expedition.Date_PEC, Sum(Expedition!Colis) AS Somme_Colis, Sum(STV_R!Nbre_Colis_non_lus) AS Somme_Colis_non_lus, ((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux, Equipe.Equipe"
Requete = Requete & " FROM (Expedition LEFT JOIN Equipe ON Expedition.Code_apporteur = Equipe.Code_apporteur) LEFT JOIN STV_R ON (Expedition.Recep = STV_R.Recep) AND (Expedition.CD = STV_R.CD) AND (Expedition.Date_PEC = STV_R.Date_PEC)"
Requete = Requete & " GROUP BY Expedition.Date_PEC, Equipe.Equipe"
Requete = Requete & " HAVING (((Expedition.Date_PEC)=20150225) AND ((Equipe.Equipe)='N'));"
 
Set Rs = OpenRecordSet(Requete, Connexion)
Range("M" & LIGNE_DA) = Rs.Fields("Taux")
 
Rs.Close
Set Rs = Nothing
Set Rs = New ADODB.Recordset
 
'Taux CD
Requete = "SELECT Expedition.Date_PEC, Sum(Expedition!Colis) AS Somme_Colis, Sum(STV_R!Nbre_Colis_non_lus) AS Somme_Colis_non_lus, ((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux, Expedition.CD"
Requete = Requete & " FROM Expedition LEFT JOIN STV_R ON (Expedition.Date_PEC = STV_R.Date_PEC) AND (Expedition.CD = STV_R.CD) AND (Expedition.Recep = STV_R.Recep)"
Requete = Requete & " GROUP BY Expedition.Date_PEC, Expedition.CD"
Requete = Requete & " HAVING (((Expedition.Date_PEC)=20150225));"
 
 Set Rs = OpenRecordSet(Requete, Connexion)
 
Sheets("REQUETE").Range("A1").CopyFromRecordset Rs
 
Sheets("REQUETE").Select
lg = Range("A1").End(xlDown).Row
For i = 1 To lg
    CD = Range("B" & i).Value
    TX = Range("C" & i).Value
    Sheets("TX_CD").Select
        Set PlageDeRecherche = ActiveSheet.Rows(1)
        Set Trouve = PlageDeRecherche.Cells.Find(what:=CD, LookAt:=xlWhole)
        If Trouve Is Nothing Then
            GoTo suite
        Else
            COLONNE = Trouve.Column
            Set MaPlage = Columns(COLONNE).Rows(LIGNE_DA)
            MaPlage.Value = TX
            If MaPlage.Value = "" Then
                MaPlage.Value = 100
            End If
        End If
'vidage des variables
Set PlageDeRecherche = Nothing
Set Trouve = Nothing
 
suite:
    Sheets("REQUETE").Select
Rs.Close
Set Rs = Nothing
Set Connexion = Nothing
 
End Sub

17/03/2015, 14h01
hoodoo

1 pièce(s) jointe(s)

Bonjour Rdurupt,

J'ai essayé mais cette fois ci, j'ai cette erreur dès le début de la première requête :

Citation:

Erreur d'exécution '429'

Un Compostant ActiveX ne peut pas créer d'objet

J'ai bien vérifié les références activées qui sont les suivantes :

Pièce jointe 171963

Petite faute de frappe :oops:

Code:

Set OpenRecordSet = CreateObject("adodb.reordset")

au lieu de

Code:

Set OpenRecordSet = CreateObject("adodb.recordset")
Code:

1 2 3 4 5 6 7 function OpenRecordSet(Sql As String, Con As Object) As Object Set OpenRecordSet = CreateObject("adodb.recordset") With OpenRecordSet .CursorLocation = adUseClient .Open Sql, Con, adOpenDynamic, adLockOptimistic End With End Function

17/03/2015, 15h24
hoodoo

Malheureusement, ça me fait toujours la même erreur pour la requête Zone:

Citation:

La méthode Open de l'objet _Recordset a échoué

:'(
17/03/2015, 18h15
Invité
Plusieurs lisibilité, tu enregistres ta requête dans Access et tu l'appel dans vba comme une table.
Code:

1 2 Sal ="select * from requêt1"
2 tu fourni une base Access épuré de données confidentiel!
19/03/2015, 07h15
hoodoo

Bonjour,

Le soucis, c'est que je vais lancer cette requête 7 fois (pour 7 jours différents).
J'allais faire une boucle lorsque ma macro serai terminée et opérationnelle.
De plus, cette macro sera lancée par une autre personne et je ne veux pas qu'elle aille sur la base Access et risquer de faire une fausse manip comme par exemple me lancer la requête d'effacement qui s'y trouve (cette requête me sert à vider d'ancienne données pour ne pas que ma basse soit trop volumineuse).

En tout cas, je te remercie tout de même de ton aide et de ta patience.
19/03/2015, 07h44
Invité

Bonjour,
Il n'était pas question d'aller sur ta base Access mais d'enregistrer ta requête sans la close where dans Access et de faire un requête dans Excel sur cette requête.
Un select table. Ou un select requête. Ça marche pareil
19/03/2015, 09h23
hoodoo

Je ne comprends pas trop.
Pour appeler ma requête, ça je comprends, mais si ma requête change étant donné que je dois modifier la date à chaque lancement de la requête, je suis bien obligée d'aller sur ma base non ?

coté ACCESS pas de where ni de having

Code:

1
2
3
SELECT Expedition.Date_PEC, Sum(Expedition!Colis) AS Somme_Colis, Sum(STV_R!Nbre_Colis_non_lus) AS Somme_Colis_non_lus, ((1-[Somme_Colis_non_lus]/[Somme_Colis])*100) AS Taux, Zone_Rechargement.Zone, Equipe.Equipe
FROM ((Expedition LEFT JOIN STV_R ON (Expedition.Recep = STV_R.Recep) AND (Expedition.CD = STV_R.CD) AND (Expedition.Date_PEC = STV_R.Date_PEC)) LEFT JOIN Zone_Rechargement ON (Expedition.Code_traction = Zone_Rechargement.Code_traction) AND (Expedition.CD = Zone_Rechargement.CD)) LEFT JOIN Equipe ON Expedition.Code_apporteur = Equipe.Code_apporteur
GROUP BY Expedition.Date_PEC, Zone_Rechargement.Zone, Equipe.Equipe

cote vba close where!

Code:

sql="SELECT * from requet1 where Date_PEC=20150225 AND Equipe Is Null;"

mais si tu peux placer une base ACCESS épurée, je pourais regarder ton code en dans un environnement de test . c'est puls facile de débuger en live.

19/03/2015, 10h43
hoodoo

Ta solution fonctionne.

Je te remercie beaucoup de ton aide et de ta patience.

Je ne sais pas comment j'y serai arrivée.