Re : Récupération de plusieurs valeurs dans un fichier fermé
Bonsoir tout le monde
Grâce à myDearfriend et pierrejean mon fichier marche très bien, par contre, il est très, très long. C'est vrai que de récupérer plus de 70 données dans un fichier fermé, c'est ardu pour ma config. (ramenés à 30 sinon impossible à poster)
Mais pourrait-on simplifier les macros pour gagner en temps.
Sub Rapatriement()
'arret de l'afFichierage
Application.ScreenUpdating = False
Sheets("PROD MOIS").Visible = True
Sheets("PROD MOIS").Activate
With ActiveSheet
.Range("Résultat1").Value = RecupValeur(.Range("Chemin").Value, .Range("Fichier").Value, _
.Range("Feuille").Value, .Range("Cellule1").Value)
.Range("Résultat2").Value = RecupValeur(.Range("Chemin").Value, .Range("Fichier").Value, _
.Range("Feuille").Value, .Range("Cellule2").Value)
.Range("Résultat3").Value = RecupValeur(.Range("Chemin").Value, .Range("Fichier").Value, _
.Range("Feuille").Value, .Range("Cellule3").Value)
.Range("Résultat4").Value = RecupValeur(.Range("Chemin").Value, .Range("Fichier").Value, _
.Range("Feuille").Value, .Range("Cellule4").Value)
.Range("Résultat5").Value = RecupValeur(.Range("Chemin").Value, .Range("Fichier").Value, _
.Range("Feuille").Value, .Range("Cellule5").Value)
.Range("Résultat6").Value = RecupValeur(.Range("Chemin").Value, .Range("Fichier").Value, _
.Range("Feuille").Value, .Range("Cellule6").Value)
.Range("Résultat7").Value = RecupValeur(.Range("Chemin").Value, .Range("Fichier").Value, _
.Range("Feuille").Value, .Range("Cellule7").Value)
.Range("Résultat8").Value = RecupValeur(.Range("Chemin").Value, .Range("Fichier").Value, _
.Range("Feuille").Value, .Range("Cellule8").Value)
.Range("Résultat9").Value = RecupValeur(.Range("Chemin").Value, .Range("Fichier").Value, _
.Range("Feuille").Value, .Range("Cellule9").Value)
.Range("Résultat10").Value = RecupValeur(.Range("Chemin").Value, .Range("Fichier").Value, _
.Range("Feuille").Value, .Range("Cellule10").Value)
.Range("Résultat11").Value = RecupValeur(.Range("Chemin").Value, .Range("Fichier").Value, _
.Range("Feuille").Value, .Range("Cellule11").Value)
.Range("Résultat12").Value = RecupValeur(.Range("Chemin").Value, .Range("Fichier").Value, _
.Range("Feuille").Value, .Range("Cellule12").Value)
.Range("Résultat13").Value = RecupValeur(.Range("Chemin").Value, .Range("Fichier").Value, _
.Range("Feuille").Value, .Range("Cellule13").Value)
.Range("Résultat14").Value = RecupValeur(.Range("Chemin").Value, .Range("Fichier").Value, _
.Range("Feuille").Value, .Range("Cellule14").Value)
.Range("Résultat15").Value = RecupValeur(.Range("Chemin").Value, .Range("Fichier").Value, _
.Range("Feuille").Value, .Range("Cellule15").Value)
End With
Sheets("PROD MOIS").Visible = False
'arret de l'affichage
Application.ScreenUpdating = True
End Sub
La fonction :
Option Explicit
Public Function RecupValeur(chemin, Fichier, Feuille, Cellule) As Variant
' Récupère une valeur dans un classeur fermé
'arret de l'affichage
Application.ScreenUpdating = False
Dim Cible1 As String
Dim Cible2 As String
Dim Cible3 As String
Dim Cible4 As String
Dim Cible5 As String
Dim Cible6 As String
Dim Cible7 As String
Dim Cible8 As String
Dim Cible9 As String
Dim Cible10 As String
Dim Cible11 As String
Dim Cible12 As String
Dim Cible13 As String
Dim Cible14 As String
Dim Cible15 As String
' Vérifier que le classeur existe
If Right(chemin, 1) <> "\" Then chemin = chemin & "\"
If Dir(chemin & Fichier) = "" Then
RecupValeur = "<< Cible non trouvée >>"
Exit Function
End If
' Reconstitue le chemin complet qui conduit à la cellule cible
Cible1 = "'" & chemin & "[" & Fichier & "]" & Feuille & "'!" & Range(Cellule).Range("A1").Address(, , xlR1C1)
Cible2 = "'" & chemin & "[" & Fichier & "]" & Feuille & "'!" & Range(Cellule).Range("A1").Address(, , xlR1C1)
Cible3 = "'" & chemin & "[" & Fichier & "]" & Feuille & "'!" & Range(Cellule).Range("A1").Address(, , xlR1C1)
Cible4 = "'" & chemin & "[" & Fichier & "]" & Feuille & "'!" & Range(Cellule).Range("A1").Address(, , xlR1C1)
Cible5 = "'" & chemin & "[" & Fichier & "]" & Feuille & "'!" & Range(Cellule).Range("A1").Address(, , xlR1C1)
Cible6 = "'" & chemin & "[" & Fichier & "]" & Feuille & "'!" & Range(Cellule).Range("A1").Address(, , xlR1C1)
Cible7 = "'" & chemin & "[" & Fichier & "]" & Feuille & "'!" & Range(Cellule).Range("A1").Address(, , xlR1C1)
Cible8 = "'" & chemin & "[" & Fichier & "]" & Feuille & "'!" & Range(Cellule).Range("A1").Address(, , xlR1C1)
Cible9 = "'" & chemin & "[" & Fichier & "]" & Feuille & "'!" & Range(Cellule).Range("A1").Address(, , xlR1C1)
Cible10 = "'" & chemin & "[" & Fichier & "]" & Feuille & "'!" & Range(Cellule).Range("A1").Address(, , xlR1C1)
Cible11 = "'" & chemin & "[" & Fichier & "]" & Feuille & "'!" & Range(Cellule).Range("A1").Address(, , xlR1C1)
Cible12 = "'" & chemin & "[" & Fichier & "]" & Feuille & "'!" & Range(Cellule).Range("A1").Address(, , xlR1C1)
Cible13 = "'" & chemin & "[" & Fichier & "]" & Feuille & "'!" & Range(Cellule).Range("A1").Address(, , xlR1C1)
Cible14 = "'" & chemin & "[" & Fichier & "]" & Feuille & "'!" & Range(Cellule).Range("A1").Address(, , xlR1C1)
Cible15 = "'" & chemin & "[" & Fichier & "]" & Feuille & "'!" & Range(Cellule).Range("A1").Address(, , xlR1C1)
' Execute une macro XLM
RecupValeur = ExecuteExcel4Macro(Cible1)
RecupValeur = ExecuteExcel4Macro(Cible2)
RecupValeur = ExecuteExcel4Macro(Cible3)
RecupValeur = ExecuteExcel4Macro(Cible4)
RecupValeur = ExecuteExcel4Macro(Cible5)
RecupValeur = ExecuteExcel4Macro(Cible6)
RecupValeur = ExecuteExcel4Macro(Cible7)
RecupValeur = ExecuteExcel4Macro(Cible8)
RecupValeur = ExecuteExcel4Macro(Cible9)
RecupValeur = ExecuteExcel4Macro(Cible10)
RecupValeur = ExecuteExcel4Macro(Cible11)
RecupValeur = ExecuteExcel4Macro(Cible12)
RecupValeur = ExecuteExcel4Macro(Cible13)
RecupValeur = ExecuteExcel4Macro(Cible14)
RecupValeur = ExecuteExcel4Macro(Cible15)
'arret de l'affichage
Application.ScreenUpdating = True
End Function
Merçi
A+ Pat5 ;o)
