Passage d'un nom de fichier à un fonction : pb open wb
yg_be Messages postés 23541 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
- Passage d'un nom de fichier à un fonction : pb open wb
- Comment réduire la taille d'un fichier - Guide
- Comment ouvrir un fichier epub ? - Guide
- Fichier bin - Guide
- Fonction si et - Guide
- Impossible de supprimer un fichier - Guide
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 Function
On 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+
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 ?