Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel problème d'emploi avec la fonction GetValue de J. Walkenbach

problème d'emploi avec la fonction GetValue de J. Walkenbach

2 réponses
Avatar
Antoine
Bonjour à tous,

J'essaie d'exploiter la fonction GetValue de J. Walkenbach (sur Excelabo
traduite par Flo-fichier/fcgd-lireferme) dans un programme, après avoir
vérifier que je peux exploiter les données (selon le nom de la feuille). Le
programme de vérification du nom de la feuille (transmis par michdenis)
fonctionne bien, mais pas la fonction GetValue pour le transfert : elle
m'indique ne pas trouver les fichiers pourtant détectés !
Je ne sais plus trop quoi penser.
Ci-dessous, la fonction GetValue de J. Walkenbach, puis le programme où est
la fonction.

Merci pour votre aide

Antoine

Function GetValue(Path, File, Sheet, Ref)

Dim Arg As String
If Right(Path, 1) <> "\" Then Path = Path & "\"
If Dir(Path & File) = "" Then
GetValue = "File Not Found"
Exit Function
End If
Arg = "'" & Path & "[" & File & "]" & Sheet & "'!" &
Range(Ref).Range("A1").Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(Arg)
End Function

Sub transfert_donnees()

Dim lig As Integer, col As Byte, A(3)
Dim chemin, fichier, feuille As String
Dim cnn As New ADODB.Connection
Dim Cat As New ADOX.Catalog
Dim Tbl As ADOX.Table
lig = 2 ' décale la 1ère ligne de recopie
chemin = ActiveWorkbook.Path
fichier = Dir$(chemin & "\*.xls")
feuille = "Salariés"
Do Until fichier = ""
If fichier = "Récapitulatif.xls" Then
GoTo saute
Else ' programme de recherche du nom de la feuille de michdenis
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & chemin & "\" & fichier & ";" & _
"Extended Properties=Excel 8.0;"
Cat.ActiveConnection = cnn
For Each Tbl In Cat.Tables
If InStr(1, Tbl.Name, "$") > 0 Then
MsgBox Left$(Tbl.Name, Len(Tbl.Name) - 1)
If Left$(Tbl.Name, Len(Tbl.Name) - 1) = feuille Then
MsgBox (fichier) ' précise le nom de chaque fichier
détecté
A(2) = GetValue(chemin, fichier, "Salariés", "S7")
A(3) = GetValue(chemin, fichier, "Salariés", "D9")
lig = lig + 1 ' recopie les cellules sur le fichier de la
macro
For col = 2 To 3
Feuil3.Cells(lig, col) = A(col)
Next col
End If
End If
Next Tbl
Set Cat = Nothing
cnn.Close
Set cnn = Nothing
saute:
fichier = Dir$
End If
Loop
End Sub
Signaler un problème avec ce contenu

2 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
michdenis
Bonjour Antoine,

avant d'essayer d'intégrer la fonction de John dans ta procédure,
fais quelques tests séparément ....

Évidemment, tu dois adapter la ligne de commande :

'----------------------------
Sub Test()
MsgBox GetValue("C:Excel","MonFichier.xls","MaFeuille","A")
End Sub
'----------------------------

Public Function GetValue(ByVal path, ByVal file, ByVal sheet, ByVal ref) As
Variant

' Macro XL4 Merci à John Walkenbach
' ============================= ' Retrieves a value from a closed workbook

Dim Arg As String

' Make sure the file exists
If Right(path, 1) <> "" Then path = path & ""
If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
End If

' Create the argument
Arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Address(, , xlR1C1)
' MsgBox Arg
' Execute an XLM macro
GetValue = Application.ExecuteExcel4Macro(Arg)
DoEvents

End Function
'----------------------------


Salutations!




"Antoine" a écrit dans le message de news:
Bonjour à tous,

J'essaie d'exploiter la fonction GetValue de J. Walkenbach (sur Excelabo
traduite par Flo-fichier/fcgd-lireferme) dans un programme, après avoir
vérifier que je peux exploiter les données (selon le nom de la feuille). Le
programme de vérification du nom de la feuille (transmis par michdenis)
fonctionne bien, mais pas la fonction GetValue pour le transfert : elle
m'indique ne pas trouver les fichiers pourtant détectés !
Je ne sais plus trop quoi penser.
Ci-dessous, la fonction GetValue de J. Walkenbach, puis le programme où est
la fonction.

Merci pour votre aide

Antoine

Function GetValue(Path, File, Sheet, Ref)

Dim Arg As String
If Right(Path, 1) <> "" Then Path = Path & ""
If Dir(Path & File) = "" Then
GetValue = "File Not Found"
Exit Function
End If
Arg = "'" & Path & "[" & File & "]" & Sheet & "'!" &
Range(Ref).Range("A1").Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(Arg)
End Function

Sub transfert_donnees()

Dim lig As Integer, col As Byte, A(3)
Dim chemin, fichier, feuille As String
Dim cnn As New ADODB.Connection
Dim Cat As New ADOX.Catalog
Dim Tbl As ADOX.Table
lig = 2 ' décale la 1ère ligne de recopie
chemin = ActiveWorkbook.Path
fichier = Dir$(chemin & "*.xls")
feuille = "Salariés"
Do Until fichier = ""
If fichier = "Récapitulatif.xls" Then
GoTo saute
Else ' programme de recherche du nom de la feuille de michdenis
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & chemin & "" & fichier & ";" & _
"Extended Properties=Excel 8.0;"
Cat.ActiveConnection = cnn
For Each Tbl In Cat.Tables
If InStr(1, Tbl.Name, "$") > 0 Then
MsgBox Left$(Tbl.Name, Len(Tbl.Name) - 1)
If Left$(Tbl.Name, Len(Tbl.Name) - 1) = feuille Then
MsgBox (fichier) ' précise le nom de chaque fichier
détecté
A(2) = GetValue(chemin, fichier, "Salariés", "S7")
A(3) = GetValue(chemin, fichier, "Salariés", "D9")
lig = lig + 1 ' recopie les cellules sur le fichier de la
macro
For col = 2 To 3
Feuil3.Cells(lig, col) = A(col)
Next col
End If
End If
Next Tbl
Set Cat = Nothing
cnn.Close
Set cnn = Nothing
saute:
fichier = Dir$
End If
Loop
End Sub
Avatar
Antoine
Bonjour Michdenis,

Juste une petite pause, repas d'anniversaire oblige (pas le mien !), pour te
remercier de ton aide ; il m'est difficilement mettre en application tes
propositions maintenant.

Merci pour ton aide dans tout les cas.
Je te tiens informé demain, dans le MFPE.

Merci encore

Antoine

"michdenis" a écrit dans le message de news:

Bonjour Antoine,

avant d'essayer d'intégrer la fonction de John dans ta procédure,
fais quelques tests séparément ....

Évidemment, tu dois adapter la ligne de commande :

'----------------------------
Sub Test()
MsgBox GetValue("C:Excel","MonFichier.xls","MaFeuille","A")
End Sub
'----------------------------

Public Function GetValue(ByVal path, ByVal file, ByVal sheet, ByVal ref)
As
Variant

' Macro XL4 Merci à John Walkenbach
' ============================= > ' Retrieves a value from a closed workbook

Dim Arg As String

' Make sure the file exists
If Right(path, 1) <> "" Then path = path & ""
If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
End If

' Create the argument
Arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Address(, , xlR1C1)
' MsgBox Arg
' Execute an XLM macro
GetValue = Application.ExecuteExcel4Macro(Arg)
DoEvents

End Function
'----------------------------


Salutations!




"Antoine" a écrit dans le message de news:

Bonjour à tous,

J'essaie d'exploiter la fonction GetValue de J. Walkenbach (sur Excelabo
traduite par Flo-fichier/fcgd-lireferme) dans un programme, après avoir
vérifier que je peux exploiter les données (selon le nom de la feuille).
Le
programme de vérification du nom de la feuille (transmis par michdenis)
fonctionne bien, mais pas la fonction GetValue pour le transfert : elle
m'indique ne pas trouver les fichiers pourtant détectés !
Je ne sais plus trop quoi penser.
Ci-dessous, la fonction GetValue de J. Walkenbach, puis le programme où
est
la fonction.

Merci pour votre aide

Antoine

Function GetValue(Path, File, Sheet, Ref)

Dim Arg As String
If Right(Path, 1) <> "" Then Path = Path & ""
If Dir(Path & File) = "" Then
GetValue = "File Not Found"
Exit Function
End If
Arg = "'" & Path & "[" & File & "]" & Sheet & "'!" &
Range(Ref).Range("A1").Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(Arg)
End Function

Sub transfert_donnees()

Dim lig As Integer, col As Byte, A(3)
Dim chemin, fichier, feuille As String
Dim cnn As New ADODB.Connection
Dim Cat As New ADOX.Catalog
Dim Tbl As ADOX.Table
lig = 2 ' décale la 1ère ligne de recopie
chemin = ActiveWorkbook.Path
fichier = Dir$(chemin & "*.xls")
feuille = "Salariés"
Do Until fichier = ""
If fichier = "Récapitulatif.xls" Then
GoTo saute
Else ' programme de recherche du nom de la feuille de michdenis
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & chemin & "" & fichier & ";" & _
"Extended Properties=Excel 8.0;"
Cat.ActiveConnection = cnn
For Each Tbl In Cat.Tables
If InStr(1, Tbl.Name, "$") > 0 Then
MsgBox Left$(Tbl.Name, Len(Tbl.Name) - 1)
If Left$(Tbl.Name, Len(Tbl.Name) - 1) = feuille Then
MsgBox (fichier) ' précise le nom de chaque fichier
détecté
A(2) = GetValue(chemin, fichier, "Salariés", "S7")
A(3) = GetValue(chemin, fichier, "Salariés", "D9")
lig = lig + 1 ' recopie les cellules sur le fichier de la
macro
For col = 2 To 3
Feuil3.Cells(lig, col) = A(col)
Next col
End If
End If
Next Tbl
Set Cat = Nothing
cnn.Close
Set cnn = Nothing
saute:
fichier = Dir$
End If
Loop
End Sub