butterfly88
XLDnaute Junior
Bonjour,
Je dois faire un lien entre excel et access, pour récuperer des données et les mettre dans une liste déroulante dans excel !
donc, j'ai déja trouver une méthode qui permettrait de faire cela, mais je ne comprends pas tout !
tout d'abord je dois nommée une cellule strPath présente dans le classeur et renvoyer sur le chemin de l'application (of24xxx.mdb)
le chemin => R:\COMMUN\PROD\OF24XXX\of24xxx.mdb
Comment je fais ?
et voila le code complet :
Je dois faire un lien entre excel et access, pour récuperer des données et les mettre dans une liste déroulante dans excel !
donc, j'ai déja trouver une méthode qui permettrait de faire cela, mais je ne comprends pas tout !
tout d'abord je dois nommée une cellule strPath présente dans le classeur et renvoyer sur le chemin de l'application (of24xxx.mdb)
le chemin => R:\COMMUN\PROD\OF24XXX\of24xxx.mdb
Comment je fais ?
et voila le code complet :
Code:
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 of24xxx.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 NomEmployé As String = vbNullString, _
Optional ByVal Mois As Date = 0, _
Optional ByVal Quarterly As Boolean = False)
' Chaine de caractère : nom de l'employé ou cellule qui contient cette information
' Date : date qui va indiquer le mois de la requête ou cellule qui contient cette information
' Booléen : Si vrai => informations trimestrielles, Si faux => informations mensuelles
Dim rec As New ADODB.Recordset
Dim strSQL As String
'Redaction du SQL
strSQL = "SELECT Sum([Prix unitaire] * [Quantité]) 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(NomEmployé) > 0 Then
strSQL = strSQL & " And ([Nom] = '" & NomEmployé & "')"
End If
' rappelons que les dates en SQL sont à mettre au format US
If Mois > 0 Then
strSQL = strSQL & " And ([Date Commande] Between #" & _
Format(MoisInf(Mois, Quarterly), "mm/dd/yyyy") & "# And #" & _
Format(MoisSup(Mois, Quarterly), "mm/dd/yyyy") & "#)"
End If
Dim rst As New ADODB.Recordset
rst.Open strSQL, cnx
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
