Problème connection ADO

Version imprimable

Bonjour,

En essayant de me connecter à un autre classeur Excel via ADO, j'obtiens une erreur automation, voici le code :
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 Sub extraire_ado() Dim Source As Object, Requete As Object Dim chemin As String Dim Onglet As String, Plage As String Dim Texte_SQL As String chemin = "D:\" Fichier = "code.xlsm" Onglet = "Feuil5" Onglet = Onglet & "$" Plage = "B2:B10000" Set Source = CreateObject("ADODB.Connection") With Source .Provider = "Microsoft.Jet.OLEDB.2.8" .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _ & chemin & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;""" .Open End With Texte_SQL = "SELECT * FROM [" & Onglet & Plage & "]" Set Requete = CreateObject("ADODB.Recordset") Set Requete = Source.Execute(Texte_SQL) Range("C3").CopyFromRecordset Requete Requete.Close Set Requete = Nothing Source.Close Set Source = Nothing End Sub
Il bloque au niveau de

Code:

Set Requete = Source.Execute(Texte_SQL)

Je vous informe d'ailleurs que la propriété State de la connexion ADO est sur 1. Le fichier n'est pas non plus protégé.

Celà est mon premier problème.

Mon deuxième problème est que dans la l'instruction

Code:

Texte_SQL = "SELECT * FROM [" & Onglet & Plage & "]"

, je voudrais pouvoir selectionner qu'une seule cellule (pas une plage) qui est elle-même variable (boucle avec do). Le but est de comparer la valeur de la cellule 1 d'un classeur ouvert à celle d'un classeur fermé (cellule 2) (en parcourant une colonne), d'arreter quand les deux valeurs sont égales et enfin d'utiliser la valeur de la cellule 3 (dans le classeur fermé) et la multiplier par la cellule 4 (dans le classeur ouvert), le resultat sera affiché dans une cellule 5 du classeur ouvert. J'espère que c'est compréhensible.:mouarf:

Dans l'attente de résoudre le 20éme problème de Hilbert (lol), merci

16/09/2010, 07h44
AlainTech

Bonjour,

Citation:

Envoyé par sliman84

j'obtiens une erreur automation

Laquelle et sur quelle ligne?
16/09/2010, 21h10
sliman84

Bonjour, j'obtiens l'erreur suivante :
Erreur d'exécution : "-2147217865 (80040e37)
A ce niveau

Code:

Set Requete = Source.Execute(Texte_SQL)

A bientot
16/09/2010, 21h23
kiki29

Salut, voir http://silkyroad.developpez.com/VBA/ClasseursFermes/ pour une syntaxe correcte
16/09/2010, 21h31
sliman84

J'ai obtenu une partie de mon code de ce fichier, j'ai utlisé plusieurs syntaxes mais ca bloque toujours au niveau de la lecture du recordset, j'ai même utlisé la syntaxe avec open et non execute et j'obtiens toujours la même erreur.
17/09/2010, 01h11
sliman84

Bonjour, j'ai resolu en partie le problème.
Maintenant j'ai un problème de valeur, en effet l'instruction :

Code:

Set Rst1 = Cn.Execute(texte_SQL1)

m'affiche "CH# CART 24X32" au lieu de "CH. CART 24X32"
Avec les autres cellules au format texte, je n'ai aucun problème, par contre j'ai un problème avec les cellules ou il y a des points comme ici.
Autre problème, la valeur d'un recordset est égal à "F1" lorsque la cellule est totalement vide, cela pose un problème car le prog quitte la boucle quand une cellule vide est parcouru, alors que la valeur du recordset est toujours egal à F1 (boucle infiini).
17/09/2010, 10h05
AlainTech

Citation:

Envoyé par sliman84

Bonjour, j'ai resolu en partie le problème.

Bonjour,

As-tu pensé que si quelqu'un reçoit le même message d'erreur que toi, fait une recherche sur Google et tombe sur ta discussion, il ne saura pas quelle est la solution?

Le forum étant un lieu d'échange, il est important que cet échange n'aille pas que dans un seul sens.

Dis-nous donc comment tu as résolu cette partie de ton problème.

Alain tu as raison,
Voici le code presque finalisé :

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
 
Sub etat2()
 
 
Dim Cn As ADODB.Connection
Dim Fichier As String
Dim NomFeuille As String, texte_SQL1 As String, texte_SQL2 As String
Dim Rst1 As ADODB.Recordset
Dim Rst2 As ADODB.Recordset
 
 
Fichier = "D:\code.xlsm"
NomFeuille = "Feuil4$"
 
    Set Cn = New ADODB.Connection
 
    With Cn
        .Provider = "Microsoft.Jet.OLEDB.2.8"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
        & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
    End With
 
 
    m = 3
    Do
    m = m + 1
 
    Set design = Worksheets("Feuil1").Cells(m, 5)
    Set quantiteng = Worksheets("Feuil1").Cells(m, 7)
    Set prixun = Worksheets("Feuil1").Cells(m, 8)
    Set Total1 = Worksheets("Feuil1").Cells(m, 9)
 
        c = 3
        Do
        c = c + 1
        Set article = Worksheets("Feuil2").Cells(c, 1)
        Set quantite = Worksheets("Feuil2").Cells(c, 2)
        Set prixmoy = Worksheets("Feuil2").Cells(c, 3)
        Set Total2 = Worksheets("Feuil2").Cells(c, 4)
        Set poids = Worksheets("Feuil2").Cells(c, 5)
        If article.Value = design.Value Then Exit Do
 
        Loop Until article.Value = ""
 
        If (design.Value <> article.Value And article.Value = "") Then
                article.Value = design.Value
                quant = WorksheetFunction.SumIf(Worksheets("Feuil1").Range("E4:E100"), article.Value, Worksheets("Feuil1").Range("G4:G100"))
                quantite.Value = quant
 
                If quant <> 0 Then
                    prix1 = Evaluate("sumproduct((Feuil1!E4:E100=" & article.Address & ")*(Feuil1!G4:G100*Feuil1!H4:H100))")
                    prixmoy.Value = Round(prix1 / quantite, 3)
                    Total2.Value = WorksheetFunction.Round(prixmoy.Value * quantite.Value, 0)
                    Worksheets("Feuil2").Cells(c, 1).Borders.LineStyle = xlContinuous
                    Worksheets("Feuil2").Cells(c, 2).Borders.LineStyle = xlContinuous
                    Worksheets("Feuil2").Cells(c, 3).Borders.LineStyle = xlContinuous
                    Worksheets("Feuil2").Cells(c, 4).Borders.LineStyle = xlContinuous
                    Worksheets("Feuil2").Cells(c, 5).Borders.LineStyle = xlContinuous
 
                        i = 2
                        Do
                        i = i + 1
                        article3 = "B" & i
                        poids3 = "G" & i
 
 
                        texte_SQL1 = "SELECT * FROM [" & NomFeuille & article3 & ":" & article3 & "]"
                        texte_SQL2 = "SELECT * FROM [" & NomFeuille & poids3 & ":" & poids3 & "]"
 
                        Set Rst1 = New ADODB.Recordset
                        Set Rst2 = New ADODB.Recordset
 
                        Set Rst1 = Cn.Execute(texte_SQL1)
                        Set Rst2 = Cn.Execute(texte_SQL2)
 
                        'Rst1.Open texte_SQL1, Cn
                        'Rst2.Open texte_SQL2, Cn
 
                        Valeur = Rst1.Fields(0).Name
                        Valeur2 = Rst2.Fields(0).Name
 
                        If article.Value = Valeur Then Exit Do
 
                        Loop Until Valeur = "F1"
 
                        If article.Value = Valeur Then poidsuni = Valeur2
                        If Valeur2 <> "F1" Then poids.Value = Round(poidsuni * quantite.Value, 0)
                        If Valeur2 = "F1" Then poids.Value = "Aucune indication"
 
                        If Valeur = "F1" Then poids.Value = "Aucune indication"
 
 
 
 
                End If
 
                If quant = 0 Then
                    article.Clear
                    quantite.Clear
                    Total2.Clear
                    poids.Clear
                End If
        End If
 
 
        If (design.Value <> article.Value And article.Value <> "") Then
                Worksheets("Feuil2").Cells(c + 1, 1).Value = design.Value
                quant1 = WorksheetFunction.SumIf(Worksheets("Feuil1").Range("E4:E100"), Worksheets("Feuil2").Cells(c + 1, 1).Value, Worksheets("Feuil1").Range("G4:G100"))
                Worksheets("Feuil2").Cells(c + 1, 2).Value = quant1
        End If
 
        Loop Until design.Value = ""
 
 
Cn.Close
Set Cn = Nothing
 
End Sub

Ce code est diffèrent du premier car au début ce fut un test, j'ai résolu le problème en changant la syntaxe de poids3 et article3 car avant je les écrivait sous la forme article3=Cells(i,2).Adrdess qui renvoie normalement par exemple A2 ou A3 selon la valeur de i, or dans la macro cette syntaxe renvoyait dans la requête SQL un range de la forme suivante $A$2.
La syntaxe que j'ai employait dans mon code renvoie la bonne référence, c'est à dire article3="B"&i, de plus je peux effectuer des boucles dessus.

boila boila

En ce qui concerne le dernier problème du recordset comment faire s'il vous plait car je ne m'attendais pas à ce problème.
comment faire pour qu'un recordset renvoie la bonne valeur car il s'agit ici de comparer la valeur du recordset a une autre valeur et c'est un problème s'il renvoie de mauvaises valeurs.