Insérer une variable dans un chemin d'accès

Version imprimable

Bonjour,

Je suis en train d'écrire un programme qui a pour objectif d'aller chercher des informations (toujours au même endroit) dans les fichiers Excel d'un répertoire pour les réunir dans un autre fichier excel qui fait office de tableau de bord. Je souhaite que les fichiers restent fermés pendant l'exécution. Voici mon programme :
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 Sub importdonees() Dim principal As ThisWorkbook Dim repertoire As String Dim fichier As String Dim i As Integer repertoire = "P:\Valentine\Système alerte qualité\Alertes qualités\*.xlsm" fichier = Dir("P:\Valentine\Système alerte qualité\Alertes qualités\*.xlsm") i = 2 While Len(fichier) > 0 MsgBox fichier i = i + 1 Range("B" & i).Select ActiveCell.FormulaR1C1 = _ "='P:\Valentine\Système alerte qualité\Alertes qualités\[AlerteQF_20_08_19.xlsm]Alerte_qualité_fournisseur'!R4C3" Range("C" & i).Select ActiveCell.FormulaR1C1 = _ "='[AlerteQF_20_08_19.xlsm]Alerte_qualité_fournisseur'!R4C5" Range("D" & i).Select ActiveCell.FormulaR1C1 = _ "='[AlerteQF_20_08_19.xlsm]Alerte_qualité_fournisseur'!R6C3" Range("E" & i).Select ActiveCell.FormulaR1C1 = _ "='[AlerteQF_20_08_19.xlsm]Alerte_qualité_fournisseur'!R3C13" Range("F" & i).Select ActiveCell.FormulaR1C1 = _ "='[AlerteQF_20_08_19.xlsm]Alerte_qualité_fournisseur'!R9C10" fichier = Dir Wend End Sub
Pour l'instant je n'ai que 4 fichiers dans mon répertoire mais à l'avenir il pourrait y en avoir des centaines, d'où la nécessité de faire une boucle.J'ai testé, la boucle marche. Néanmoins, pour l'instant mon programme ne transfère que les valeurs d'un même fichier "AlerteQF_20_08_19.xlsm" puisque je ne l'ai pas changé.

Je cherche donc un moyen de mettre une variable dans mon chemin d'accès, comme la variable "fichier" dans mon cas qui serait parfaite pour remplacer [AlerteQF_20_08_19.xlsm]. Est-ce que cela est possible?

Merci d'avance

pas testé mais si on parle de concatenation du string de ta formule ca doit etre ca
et surtout sans select
le parent du range n'est pas précisé tu devrait le faire !!!!!!!!!!!!!

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
Sub importdonees()
 Dim principal As ThisWorkbook
 Dim repertoire As String
 Dim fichier As String
 Dim i As Integer
 
 repertoire = "P:\Valentine\Système alerte qualité\Alertes qualités\"
 fichier = Dir(repertoire & "*.xlsm")
 i = 2
 While Len(fichier) > 0
 MsgBox fichier
 i = i + 1
 
 Range("B" & i).FormulaR1C1 = "='" & repertoire & "[" & fichier & "]Alerte_qualité_fournisseur'!R4C3"
 
 Range("C" & i).FormulaR1C1 = "='" & repertoire & "[" & fichier & "]Alerte_qualité_fournisseur'!R4C5"
 
  Range("D" & i).FormulaR1C1 = "='" & repertoire & "[" & fichier & "]Alerte_qualité_fournisseur'!R6C3"
 
 Range("E" & i).FormulaR1C1 = "='" & repertoire & "[" & fichier & "]Alerte_qualité_fournisseur'!R3C13"
 
 Range("F" & i).FormulaR1C1 = "='" & repertoire & "[" & fichier & "]Alerte_qualité_fournisseur'!R9C10"
 
 fichier = Dir
 
 Wend
End sub

Attention !! j'ai oublié de précisé que dans ce répertoire il ne doit y avoir que des fichiers concernés avec un sheets("Alerte_qualité_fournisseur")
sinon il faudra mettre un test avec evaluate par exemple

18/07/2019, 15h24
Valentine_Chips

Résolu

Ca marche, merci beaucoup !!!!

J'ai indiqué les parents, c'est parfait maintenant :)

de rien
on peut simplifier le code si tu veux
ca doit être cela si je ne me trompe pas

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
Sub importdonees()
 Dim principal As ThisWorkbook
 Dim repertoire As String
 Dim fichier As String
 Dim i As Integer
 Dim formula as string
 repertoire = "P:\Valentine\Système alerte qualité\Alertes qualités\"
 fichier = Dir(repertoire & "*.xlsm")
 i = 2
 While Len(fichier) > 0
 MsgBox fichier
 i = i + 1
Formula = "=''" & repertoire & "[" & fichier & "]Alerte_qualité_fournisseur''!"
 
 Range("B" & i).FormulaR1C1 = Formula & "R4C3"
 
 Range("C" & i).FormulaR1C1 = Formula & "R4C5"
 
  Range("D" & i).FormulaR1C1 = Formula & "R6C3"
 
 Range("E" & i).FormulaR1C1 = Formula & "R3C13"
 
 Range("F" & i).FormulaR1C1 = Formula & "R9C10"
 
 fichier = Dir
 
 Wend
 End Sub

19/07/2019, 07h51
Valentine_Chips

Re

Merci j'ai tenté de mettre votre simplification en place mais elle bug à la ligne : Range("B" & i).FormulaR1C1 = formula & "R4C3".

La première version marche très bien en tout cas!

re
Bonjour
oui je me suis un peu pressé
il ne faut pas doubler les simples quotes

Code:

Formula = "='" & repertoire & "[" & fichier & "]Alerte_qualité_fournisseur'!"

j'ai testé ca fonctionne
;)

voila j'ai ajouté le test de validité de la formule
je n'y suis pas arrivé avec evaluate je l'ai fait avec ExecuteExcel4Macro
les erreurs ne devraient pas être bloquantes et si il y en a ; un message te dis sur quel fichier(s) il y a eu une/des erreur(s)

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
Sub importdonees()
    Dim principal As ThisWorkbook, repertoire$, fichier$, i%, formula$, mess$
    repertoire = "P:\Valentine\Système alerte qualité\Alertes qualités\"
    fichier = Dir(repertoire & "*.xlsm")
    feuille = "Alerte_qualité_fournisseur"
      i = 2
    While Len(fichier) > 0
         i = i + 1
        If Not IsError(ExecuteExcel4Macro("'" & repertoire & "[" & fichier & "]" & feuille & "'!" & "R4C3")) Then
 
            formula = "='" & repertoire & "[" & fichier & "]" & feuille & "'!"
            Range("B" & i).FormulaR1C1 = formula & "R4C3"
            Range("C" & i).FormulaR1C1 = formula & "R4C5"
            Range("D" & i).FormulaR1C1 = formula & "R6C3"
            Range("E" & i).FormulaR1C1 = formula & "R3C13"
            Range("F" & i).FormulaR1C1 = formula & "R9C10"
            fichier = Dir
        Else
            mess = mess & repertoire & fichier & vbCrLf
        End If
    Wend
If mess <> "" Then mess = "donnée(s) non récupérée(s) dans " & vbCrLf & mess
 
End Sub

23/07/2019, 12h07
Valentine_Chips

Re

Top ! Merci beaucoup