Passage d'un nom de fichier à un fonction : pb open wb
yg_be Messages postés 23437 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour,
J'ai une fonction à la quelle je passe un nom de fichier Excel.
Si je l'appelle depuis une sub tout va bien, si je l'appelle depuis une cellule l'instruction
Set Wb = Workbooks.Open(nom_fic) plante
voici le code
Function get_val(ByVal Date_recherche As Date, ByVal nom_fic, nom_feuille As Variant) As Double
Dim Val_trouvee As Boolean
Dim i As Integer
Dim nb_col, nb_lignes As Integer
Dim Wb As Workbook
Dim ws As Worksheet
Dim Dd, Df As Date
Set Wb = Workbooks.Open(nom_fic)
If Wb Is Nothing Then
MsgBox Prompt:="The Workbook is not available", Buttons:=vbOKOnly + vbInformation
Exit Function
End If
Set ws = Wb.Sheets(nom_feuille)
nb_lignes = ws.UsedRange.Rows.Count
i = 2
Val_trouvee = False
Do While Not (Val_trouvee)
Dd = ws.Cells(i, 1)
Df = ws.Cells(i, 2)
If (Date_recherche >= Dd) And (Date_recherche <= Df) Then
get_val = ws.Cells(i, 3)
Val_trouvee = True
Else
i = i + 1
End If
Loop
Wb.Close
End Function
'Sub de test qui marche !
Sub essai()
Dim Date1 As Date
Dim tarif As Double
Dim fic_Tarif, nom_onglet As String
Date1 = "02/09/2020"
fic_Tarif = "F:\Dominique\Documents\VBA_Exo\tarif_pour_test.xlsm"
nom_onglet = "Tarif_edf"
tarif = get_val(Date1, fic_Tarif, nom_onglet)
End Sub
Dans une cellule Excel je met
=get_val(F1;H1;G1)
avec F1 une date
H1 = F:\Dominique\Documents\VBA_Exo\tarif_pour_test.xlsm =>
G1 = Tarif_edf
Set Wb = Workbooks.Open(nom_fic) retourne "Nothing"
Merci de votre aide
Dominique
Windows / Chrome 108.0.0.0
3 réponses
-
Bonjour Kinou
Une petite fonction ADO pour le faire
' fonction ADO pour récupérer une valeur entre 2 dates ' Demande à activer la référence Microsoft ActivX Data Object dernière version ' La BdD comporte 3 colonne : Date début, Date Fin, Tarif Function Get_Val(ByVal SearchDate As Date, sPathFic As String, ShtName As String) As Double Dim oCn As ADODB.Connection Dim oRs As ADODB.Recordset Set oCn = New ADODB.Connection With oCn .Provider = "Microsoft.Jet.OLEDB.4.0" .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _ & sPathFic & ";Extended Properties=""Excel 12.0;HDR=YES;""" .Open End With Set oRs = New ADODB.Recordset oRs.Open "Select * from [" & ShtName & "$]", oCn, adOpenKeyset, adLockOptimistic Do While Not (oRs.EOF) If SearchDate >= oRs(0) And SearchDate <= oRs(1) Then Get_Val = oRs(2) Exit Do ElseIf oRs(0) <> "" Then oRs.MoveNext Else Exit Do End If Loop oCn.Close Set oRs = Nothing: Set oCn = Nothing End FunctionOn pourrait utiliser une condition Where, mais il faudrait que le nom d'entête des colonnes soit toujours le même
A+
-
Bonjour yg_be
La fonction est en cours d'exécution lorsque l'on veut ouvrir le fichier, d'où le problème
Avez vous essayé chez vous au moins !?
A+
-
yg_be Messages postés 23437 Date d'inscription Statut Contributeur Dernière intervention Ambassadeur 1 588
bonjour,
Tu es certain que le fichier tarif_pour_test.xlsm n'est pas ouvert au moment de l'appel?
J'essaierais deux choses:- mettre un point d'arrêt dans la fonction get_val, et l'exécuter pas à pas quand elle est appelée à partir de la formule
- dans la fonction essai(), mettre
fic_Tarif = [H1]
-
Bonsoir yg_be,
Merci pour ta réponse et 1000 excuses pour ce retour tardif.
Le fichier tarif_pout_test.xlsm est bien fermé au moment de l'appel.
J'avais déjà testé comme indiqué dans 1. C'est comme ça que je sais que le open lookbook plante (renvoie "nothing")
En mettant fic_tarif = [H1] ça marche mais je vois pas ce que je peux faire pour pouvoir depuis une feuille Excel appeler cette fonction avec succès ?
