Problème pour récupérer une valeur avec ExecuteExcel4Macro

Version imprimable

Bonjour,

Je suis pas du genre à demander de l'aide mais sa fait 2 jours que je me prend la tête sur une fonction pour aller récupérer des valeurs de plusieurs fichiers excel fermé...
Etant donné que la formule indirect ne fonctionne pas sur des classeurs fermés j'ai du créer une fonction similaire, en voici le code :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Public Function GetVal(ByVal search_colonne As String) Dim chemin As String, valeur With ActiveCell chemin = "'\\DSFR451-FS0001\Common_A\Suivi\Suivi des heures\" & Cells(.Row, 2) & "\SUIVI HEURES " & Cells(.Row, 2) & "\" & _ Cells(.Row, 4) & "\[" & Cells(.Row, 2) & "-W" & Cells(.Row, 5) & ".xlsm]Semaine'!" & _ Range(search_colonne & Range(Cells(.Row, 6))).Address(, , xlR1C1) If Dir("\\DSFR451-FS0001\Common_A\Suivi\Suivi des heures\" & Cells(.Row, 2) & "\SUIVI HEURES " & Cells(.Row, 2) & _ "\" & Cells(.Row, 4) & "\" & Cells(.Row, 2) & "-W" & Cells(.Row, 5) & ".xlsm") = "" Then valeur = 0 Else valeur = ExecuteExcel4Macro(chemin) End If End With GetVal = valeur End Function
quand je test dans un sub cela fonctionne parfaitement mais quand je l'utilise dans une cellule j'ai un #VALEUR!

je ne vois pas pourquoi il ne m'affiche pas la valeur

pourriez-vous me dire ce que j'ai mal fait ???

31/08/2018, 18h39
eriiic

Bonjour,

Déjà tu mets With ActiveCell. Etrange pour une fonction qui ne sera pas forcément dans la cellule active.
Utilise plutôt

Code:

Application.ThisCell

ou

Code:

Application.Caller

pour savoir d'où vient l'appel.
Ca ne résoudra pas ton #VALEUR! mais ça sera plus correct.
Une suggestion à tester : mettre dans un nom pour qu'il évalue ta formule
eric

bonjour
au dela de ce que dit eriic je dirais meme qu'une cells n'a rien a faire dans cette fonction

ta fonction est sensée te ramener une valeur de cellule d'un fichier fermé et c'est tout

et perso plutot que des chemin en dur dans le code de la fonction je l'utiliserais en argument elle pourrais te reservir

un peu dans ce genre la
pour tester la fonction
Code:

1 2 3 4 5 6 7 8 Sub test() Dim chemin$, fichier$, feuille$, cellule As Range chemin = "C:\Users\polux\Desktop" fichier = "hhhhhtml.xls" feuille = "Feuil1" Set cellule = Range("C4") MsgBox GetVal_on_closed_fich(chemin, fichier, feuille, cellule) End Sub
la fonction
Code:

1 2 3 4 5 Function GetVal_on_closed_fich(ByVal chemin As String, ByVal fichier As String, ByVal feuille As String, cel As Range) As Variant Dim Rc Rc = "R" & cel.Row & "C" & cel.Column GetVal_on_closed_fich = ExecuteExcel4Macro("'" & chemin & "\[" & fichier & "]" & feuille & "'!" & Rc) End Function
ca devient tout de suite plus clair dans la fonction ;)
et en plus elle peut te servir pour differentes cellule il suffit de modifier les argument dans la sub ,la fonction reste la meme

re et pour le fun

re et pour le fun et pour faire rougir robert le saint(Adob.connection"):ave:

voici un model qui te ramera un string pour une valeur ou un tableau pour une plage de cellules

Code:

1
2
3
4
5
6
7
8
9
Sub récup_une_plage_de_cellules()
    Dim chemin$, fichier$, feuille$, cellule As Range, rang As Range
    chemin = "C:\Users\polux\Desktop"
    fichier = "hhhhhtml.xls"
    feuille = "Feuil1"
    Set rang = Range("E3:F5")
    tablo = (GetVal_on_closed_fich(chemin, fichier, feuille, rang))
    Cells(1, 1).Resize(UBound(tablo), UBound(tablo, 2)) = tablo
End Sub

Code:

1
2
3
4
5
6
7
8
Sub récup_une_seule_valeur()
    Dim chemin$, fichier$, feuille$, cellule As Range, rang As Range
    chemin = "C:\Users\polux\Desktop"
    fichier = "hhhhhtml.xls"
    feuille = "Feuil1"
    Set rang = Range("E3")
    MsgBox GetVal_on_closed_fich(chemin, fichier, feuille, rang)
  End Sub

'La fonction retourne un string ou tableau
'1 un string si l'argument "rang" est une seule celluleet donc sa valeur
'2 une variable tableau si rang est une plage de cellules donc les !! valeurs dans une variable tableau

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Function GetVal_on_closed_fich(ByVal chemin As String, ByVal fichier As String, ByVal feuille As String, rang As Range) As Variant
    Dim Rc$, tableau(), lig&, col&
    If rang.Cells.Count = 1 Then
        Rc = "R" & rang.Row & "C" & rang.Column
        GetVal_on_closed_fich = ExecuteExcel4Macro("'" & chemin & "\[" & fichier & "]" & feuille & "'!" & Rc)
    Else
        ReDim tableau(1 To rang.Rows.Count, 1 To rang.Columns.Count)
        For Each cel In rang.Cells
            lig = cel.Row: col = cel.Column
            Rc = "R" & lig & "C" & col
            tableau(lig - rang.Row + 1, col - rang.Column + 1) = ExecuteExcel4Macro("'" & chemin & "\[" & fichier & "]" & feuille & "'!" & Rc)
        Next
        GetVal_on_closed_fich = tableau
    End If
End Function

pardon robert :whistle::mouarf:

03/09/2018, 11h37
lege00

problème pour récupérer une valeur avec ExecuteExcel4Macro
Bonjour,

Pour commencer je tenais à vous remercier pour vos réponse.

je n'ai pas eu de formation VBA donc forcément mon code reste basic,
Je ne connaissait pas la fonction thiscell donc j'ai utilisé activecell
car j'utilise des valeurs de certaines colonnes de la même ligne ou se trouve la formule car les fichiers ne se trouvent pas tous au même endroit.

j'ai essayé tous vos code et j'arrive au même résultat...

quand je le test dans un sub cela me retourne bien ma valeur cherché mais quand je l'insère dans une cellule alors j'obtiens un #VALEUR!

voici le code de mon test (pour info H_EXP_filmage est une plage nommée) :
Code:

1 2 3 Sub test() MsgBox GetVal(Range("H_EXP_filmage")) End Sub
et la il m'affiche bien la valeur

et voici ce que je met dans la cellule (dans la cellule AF se trouve la plage nommé H_EXP_filmage) :

Code:

=getval(H_EXP_filmage)

quand j'exécute au pas à pas au final, j'ai bien l'adresse complète ou se trouve ma valeur mais il me met quand même #VALEUR!
03/09/2018, 11h58
patricktoulon

re
re
Citation:
voici le code de mon test (pour info H_EXP_filmage est une plage nommée) :

Code:

1 2 3 Sub test() MsgBox GetVal(Range("H_EXP_filmage")) End Sub
ma fois si ta plage nommée est une plage de plusieurs cellules ca risque pas de fonctionner c'est sur

on ne peut pas mettre x cellules dans une
a tu seulement essayer d'adapter mon code post3? il est on ne peut plus simple

problème pour récupérer une valeur avec ExecuteExcel4Macro

bonjour patricklouton,

oui j'ai réadapter mon code en me basant sur le tiens :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 Public Function GetVal(ByVal search_colonne As String) As Variant Dim chemin$, fichier$, feuille$, cellule As Range, Rc, valeur With Application.ThisCell chemin = "\\DSFR451-FS0001\Common_A\Suivi\Suivi des heures\" & Cells(.Row, 2) & "\SUIVI HEURES " & Cells(.Row, 2) & "\" & Cells(.Row, 4) & "\" fichier = Cells(.Row, 2) & "-W" & Cells(.Row, 5) & ".xlsm" feuille = "Semaine" Rc = Range(search_colonne & Range(Cells(.Row, 6))).Address(, , xlR1C1) End With If Dir(chemin & fichier) = "" Then GetVal = 0: End GetVal = ExecuteExcel4Macro("'" & chemin & "\[" & fichier & "]" & feuille & "'!" & Rc) End Function
Pour la plage nommé elle ne prend qu'une seul cellule et j'ai essayé de mettre juste la colonne mais cela ne change rien...

quand je met msgbox "'" & chemin & "\[" & fichier & "]" & feuille & "'!" & Rc
j'ai bien l'adresse exact de ma valeur cherché mais il me l'affiche que lorsque j'utilise cette fonction dans un SUB

03/09/2018, 12h31
patricktoulon

re

re
oui bonjour
autant pour moi j'ai le meme phénomene
je vais regarder ce soir en rentrant

Bonjour,

Je pense qu'il y a conflit entre la fonction d'appel dans Excel et l'appel d'ExecuteExcel4Macro(), je ne pense pas que tu puisses l'utiliser dans une fonction Excel mais j'espère me tromper !
Tu peux utiliser ADO par exemple :

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
 
Private Sub ConnectCLasseur(ConnectCL As Object, _
                            Fichier As String, _
                            Optional Rs)
 
    Set ConnectCL = CreateObject("ADODB.Connection")
    If Not IsMissing(Rs) Then
        Set Rs = CreateObject("ADODB.Recordset")
    End If
 
    ConnectCL.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
              "Data Source=" & Fichier & ";" & _
              "Extended Properties=""Excel 8.0;HDR=NO;IMEX= 2;"""
 
End Sub
 
Function GetVal(Chemin As String, _
                Classeur As String, _
                Feuille As String, _
                Col As String, _
                Lig As Long)
 
    Dim ConnectCL As Object
    Dim Rs As Object
    Dim Champ As Object
    Dim Plage As String
    Dim Valeur As String
    Dim I As Integer
 
 
    ConnectCLasseur ConnectCL, Chemin & Classeur, Rs
 
    Plage = Col & ":" & Col
 
    With Rs
 
        .CursorType = 1
        .LockType = 3
        .Open "SELECT * FROM `" & Feuille & "$" & Plage & "` ", ConnectCL
 
        .MoveFirst
 
        Do While Not .EOF
 
            For Each Champ In .Fields
 
                I = I + 1
                If Not IsNull(Champ.Value) And I = Lig Then Valeur = Champ.Value: Exit Do
 
            Next
 
            .MoveNext
 
        Loop
 
    End With
 
    ConnectCL.Close
 
    GetVal = Valeur
 
    Set Rs = Nothing
    Set ConnectCL = Nothing
 
End Function

et tu appelles la fonction de cette façon :

Code:

1
2
 
=GetVal("C:\Dossier1\Dossier2\";"Nom Classeur.xlsm";"Feuil1";"A";4)

=GetVal(Chemin complet avec dernier anti-slash;Nom du classeur avec extension;Nom de la feuille;Lettre de la colonne;Numéro de la ligne)

15/10/2020, 10h48
Baboutz

1 pièce(s) jointe(s)

Bonjour,

Je me permet de remonter ce fil.

Je suis dans le même cas que lege00, j'ai d'abords tenté avec ExecuteExcel4Macro dans une fonction mais cela n'est pas possible.

J'ai donc tenté différent moyen avec ADO mais en vain... Le code de Theze est très intéressant mais la macro s'arrête sur la ligne :

Code:

If Not IsNull(Champ.Value) And I = Lig Then Valeur = Champ.Value: Exit Do

Après quelques tests, je m'aperçois que c'est l'objet champ qui pose problème...
En effet, cette variable n'est jamais renseigné et on l'utilise !

Mais, je n'ai pas les compétences pour corriger ce code afin qu'il fonctionne.

Si vous avez une piste, je suis preneur !

Merci et bonne journée,

Baboutz

Pièce jointe 581507