Problème ADO - excel - access
Bonjour,
Je suis actuellement en train d'essayer de lier une base access avec un tableur excel (le tableur me servant à calculer mes tarifs, la base access à enregistrer les prix de mes fournisseurs).
Je me suis servi de ce tutoriel, qui semble correspondre à ce que je souhaite faire (dernière méthode, via ADO) :
http://cafeine.developpez.com/access/tutoriel/excel/
Seulement voilà, ça ne semble pas fonctionner chez moi, et je ne vois pas pourquoi. Je tourne en rond depuis ce we.
L'exemple étant assez facile à rééditer, je me dis que si certains ont des connaissances sur cette question, ils verront certainement mieux que moi d'où ça vient. Le but, c'est de récupérer dans mon tableur excel, le prix d'un produit, en fonction de sa référence (passée en argument)
J'ai une base : mabase.mdb
Dans cette base, une table "TARIF_FOURNISSEUR", avec les champs suivants :
Champ "REF_PRODUIT" (texte)
Champ "PRIX_UNITE_UTILISE" (reel simple, en euro)
J'ai également une requète qui affiche l'ensemble de tout ça, comme suggéré dans le tutoriel :
Code:
1 2
| SELECT TARIF_FOURNISSEUR.REF_PRODUIT, TARIF_FOURNISSEUR.PRIX_UNITE_UTILISE
FROM TARIF_FOURNISSEUR; |
Cette requète s'appelle "qryXLSlookup"
Dans mon tableur excel, j'ai créé un "module1", qui contient le code suivant :
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
| Public cnx As ADODB.Connection
Sub auto_open()
' La sub auto_open possède la propriété d'être automatiquement
' exécutée à l'ouverture du classeur Excel
' à l'identique : auto_close est exécutée sur la fermeture
Dim strPath As String
' Seule contrainte une cellule nommée strPath
' doit être présente dans le classeur et
' renvoyer sur le chemin de l'appli
' en l'occurence Comptoir.mdb
Application.Goto Reference:="StrPath"
strPath = ActiveCell
' Nous testons si le fichier est accessible
If Len(Dir(strPath)) > 0 Then
' Déclaration de la variable de connexion
Set cnx = New ADODB.Connection
' Connexion à la base
ConnectDB cnx, strPath
Else
MsgBox "La base n'a pas pu être trouvée" & vbCrLf & _
strPath & vbCrLf & _
"n'est pas un chemin valide.", vbCritical + vbOKOnly
End If
End Sub
Sub ConnectDB(ByRef cnx As ADODB.Connection, ByVal strPath As String)
'Définition du pilote de connexion
cnx.Provider = "Microsoft.Jet.Oledb.4.0"
'Définition de la chaîne de connexion
cnx.ConnectionString = strPath
'Ouverture de la base de données
cnx.Open
End Sub
Public Function xretrieve(Optional ByVal Référence As String = vbNullString)
' Chaine de caractère : Référence du produit recherché
Dim rec As New ADODB.Recordset
Dim strSQL As String
'Redaction du SQL
strSQL = "SELECT [PRIX_UNITE_UTILISE] AS MONTANT " & _
"FROM [qryXLSlookup] WHERE 1=1"
' rappelons que les chaines de caractères en SQL sont à entourer de ''
' /!\ toute insertion de chaine dans un SQL comporte un danger pour les données
' nous pourrions fort bien ici contrôler le contenu pour neutraliser la
' la présence de mots clés placés involontairement ou par malveillance
If Len(Référence) > 0 Then
strSQL = strSQL & " And ([REF_PRODUIT] = '" & Référence & "')"
End If
Dim rst As New ADODB.Recordset
rst.Open strSQL, cnx8
On Error GoTo errH01
rst.MoveFirst
xretrieve = CDbl(rst("MONTANT"))
rst.Close
Set rst = Nothing
Exit Function
errH01:
' Nous sommes dans un tableur excel,
' nous ne cherchons pas à analyser les éventuelles erreurs
' nous rendons la main au tableur.
Err.Clear
xretrieve = 0
rst.Close
Set rst = Nothing
End Function |
Je pense avoir suivi tous les éléments du tutoriel.
Pourtant, dans mon tableur, les champs retournés sont avec l'inscription "#VALEUR!", comme s'il y avait un problème de variable.
http://img510.imageshack.us/img510/3582/excelom3.png
Auriez-vous une idée de l'erreur venue ?
A titre indicatif, voici les références activées dans Excel :
http://img266.imageshack.us/img266/8...erenceszu3.png
Merci de votre aide, pour ceux qui pourront m'en apporter.
:mrgreen: