Discussion :

[panzera]

bonjour,

au sujet de cette discussion ici.

je suis également en train de créer une macro pour additionner le montant d'une cellule spécifique dans plusieurs fichiers.
Je reçois de plusieurs requêtes par mois où je dois additionner le montant de la cellule G13 dans l'onglet "Principal" de plusieurs fichiers.
Je suis à la recherche d'un code qui puisse m'aider. Il me reste encore une question de plus, une fois que j’exécute la macro où le résultat va apparaitre?
Merci d'avance!!!

[Theze]

Bonjour,

La méthode que je te propose ici ne nécessite pas l'ouverture des classeurs par contre, il faut indiquer le chemin du dossier où ils se trouvent, le nom de la feuille cible (il doit être le même pour toutes les feuilles) et l'extension des classeurs (.xls, .xlsx, etc...) et ceci dans la proc "RecupValeurs" que tu lancera avec F5 ou le bouton "Exécuter"du VBE. Les valeurs seront inscrites en colonnes A les unes à la suite des autres. Colle ce code dans un module standard d'un classeur vierge pour voir le résultat :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
 
Sub RecupValeurs()
 
    Dim ConnectCL As Object
    Dim Rs As Object
    Dim Chemin As String
    Dim Classeur As String
    Dim NomFeuille As String
    Dim plage As String
    Dim TblClasseur() As String
    Dim TblValeur()
    Dim I As Integer
    Dim J As Integer
 
    'chemin où vont être récupérés les classeurs, à adapter...
    Chemin = "E:\Mon Dossier\"
 
    'feuille où s'effectuera la récup, à adapter...
    NomFeuille = "Feuil1"
 
    'retourne un tableau contenant tous les classeurs du dossier avec extension .xls, adapter...
    TblClasseur = RecupFichiers(ThisWorkbook.Path & "\", "xls", J)
 
    'plage ou s'effectuera la récup, pour une cellule, écrire de la façon suivante : "A1:A1"
    plage = "G13:G13"
 
    'si aucun classeur dans le dossier, fin. J est passé en Ref. et sa valeur est ensuite testée
    If J = 0 Then
 
        MsgBox "Ancun classeur ne se trouve dans ce dossier !"
        Exit Sub
 
    End If
 
    For I = 1 To UBound(TblClasseur)
 
        Classeur = TblClasseur(I)
 
        'connecxion
        ConnectCLasseur ConnectCL, Classeur, Rs
 
        ReDim Preserve TblValeur(1 To I)
 
        With Rs
 
            .CursorType = 1
            .LockType = 3
            .Open "SELECT * FROM `" & NomFeuille & "$" & _
            plage & "` ", ConnectCL
            TblValeur(I) = .Fields(0).Value
 
        End With
 
        ConnectCL.Close
 
    Next I
 
    'récupération des valeurs stockées dans le tableau
    For I = 1 To UBound(TblValeur)
 
        Range("A" & I).Value = TblValeur(I)
 
    Next I
 
End Sub
 
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.Jet.OLEDB.4.0;" & _
              "Data Source=" & Fichier & ";" & _
              "Extended Properties=""Excel 8.0;HDR=NO;IMEX= 2;"""
 
End Sub
 
Function RecupFichiers(Chemin As String, Extension As String, Retour As Integer) As String()
 
    Dim TableauFichiers() As String
    Dim Fichier As String
    Dim I As Integer
 
    Fichier = Dir(Chemin & "*." & Extension)
 
    Do While (Len(Fichier) > 0)
 
        I = I + 1
 
        ReDim Preserve TableauFichiers(1 To I)
 
        TableauFichiers(I) = Fichier
 
        Fichier = Dir()
 
    Loop
 
    Retour = I
 
    RecupFichiers = TableauFichiers()
 
End Function

Hervé.

[panzera]

Bonjour Hervé,
merci beaucoup de votre aide!
Je viens de tester votre formule mais cela m'envoie un message d'erreur. Je ne sais pas si j'ai n'est pas tout modifié comme il fallait.

Est-ce que "Nom de feuille" doit être le nom de l'onglet ou je me suis trompée sur ça?
Merci encore de votre aide!!!

Voici la ligne qui est sélectionné dans le VB:


Je pense que mon problème est sur les lignes ci dessous:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
'chemin où vont être récupérés les classeurs, à adapter...
    Chemin = "C:\Users\ABC\Documents\XYZ\shippings\"
 
    'feuille où s'effectuera la récup, à adapter...
    NomFeuille = "Principal"
 
    'retourne un tableau contenant tous les classeurs du dossier avec extension .xls, adapter...
    TblClasseur = RecupFichiers(Shippings & "\", "xls", J)

J'avais d'abord essayé sans changer la dernière ligne, mais il prenait XYZ comme Classeur. J'ai ensuite changé "ThisWorkbook.Path" pour "shippings" (le dossier où se trouve les classeurs) et il considère donc J = 0

Faut-il savoir d'avance le noms de fichiers à ouvrir?

Merci!!!

[Theze]

Bonjour,

Oups, je viens de m'apercevoir que j'ai écris des bêtises dans la construction du chemin :
à cette ligne j'indique :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Chemin = "E:\Mon Dossier\"

alors qu'à l'appel de la fonction j'écris :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
TblClasseur = RecupFichiers(ThisWorkbook.Path & "\", "xls", J)

je passe en argument le chemin du classeur où se trouve cette proc
Je te re-poste le code complet mais il te faut juste vérifier si le chemin est le bon ("C:\Users\ABC\Documents\XYZ\shippings\") et si tes classeurs ont bien l'extension "xls" sinon, adapte les. Pour que le système de récupération fonctionne il faut que tous les classeurs aient une feuille nommée "Principal" :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
 
Sub RecupValeurs()
 
    Dim ConnectCL As Object
    Dim Rs As Object
    Dim Chemin As String
    Dim Classeur As String
    Dim NomFeuille As String
    Dim plage As String
    Dim TblClasseur() As String
    Dim TblValeur()
    Dim I As Integer
    Dim J As Integer
 
    'chemin où vont être récupérés les classeurs, à adapter...
    Chemin = "C:\Users\ABC\Documents\XYZ\shippings\"
 
    'feuille où s'effectuera la récup, à adapter...
    NomFeuille = "Principal"
 
    'retourne un tableau contenant tous les classeurs du dossier avec extension .xls, adapter...
    TblClasseur = RecupFichiers(Chemin, "xls", J)
 
    'plage ou s'effectuera la récup, pour une cellule, écrire de la façon suivante : "A1:A1"
    plage = "G13:G13"
 
    'si aucun classeur dans le dossier, fin. J est passé en Ref. et sa valeur est ensuite testée
    If J = 0 Then
 
        MsgBox "Ancun classeur ne se trouve dans ce dossier !"
        Exit Sub
 
    End If
 
    For I = 1 To UBound(TblClasseur)
 
        Classeur = TblClasseur(I)
 
        'connecxion
        ConnectCLasseur ConnectCL, Classeur, Rs
 
        ReDim Preserve TblValeur(1 To I)
 
        With Rs
 
            .CursorType = 1
            .LockType = 3
            .Open "SELECT * FROM `" & NomFeuille & "$" & _
            plage & "` ", ConnectCL
            TblValeur(I) = .Fields(0).Value
 
        End With
 
        ConnectCL.Close
 
    Next I
 
    'récupération des valeurs stockées dans le tableau
    For I = 1 To UBound(TblValeur)
 
        Range("A" & I).Value = TblValeur(I)
 
    Next I
 
End Sub
 
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.Jet.OLEDB.4.0;" & _
              "Data Source=" & Fichier & ";" & _
              "Extended Properties=""Excel 8.0;HDR=NO;IMEX= 2;"""
 
End Sub
 
Function RecupFichiers(Chemin As String, Extension As String, Retour As Integer) As String()
 
    Dim TableauFichiers() As String
    Dim Fichier As String
    Dim I As Integer
 
    Fichier = Dir(Chemin & "*." & Extension)
 
    Do While (Len(Fichier) > 0)
 
        I = I + 1
 
        ReDim Preserve TableauFichiers(1 To I)
 
        TableauFichiers(I) = Fichier
 
        Fichier = Dir()
 
    Loop
 
    Retour = I
 
    RecupFichiers = TableauFichiers()
 
End Function

Désolé pour cette erreur !

Hervé.

[panzera]

j'ai encore un problème...
La macro voit toujours comme J = 0, même si toutes les conditions sont là. Elle ne trouve pas mes fichiers dans mon dossier shippings.


Dans le chemin, faut-il le "\" après le nom du dernier dossier? Le VB me renvoie un message d'erreur si je le mets.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
'chemin où vont être récupérés les classeurs, à adapter...
    Chemin = "C:\Users\ABC\Documents\XYZ\shippings"

D'autre part, dans la formule suivante n'a pas "I", faudrait-il le rajouter?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
'retourne un tableau contenant tous les classeurs du dossier avec extension .xls, adapter...
    TblClasseur = RecupFichiers(Chemin, "xls", J)

Merci de votre aide et patience

[78chris]

Bonjour

Il faut un point devant xls à mon avis : pour ma part j'utilise "*.xls" pour ce type de recherche

[panzera]

Ce n'est pas assez, la macro considérè toujours J=0.

Il faut un point devant xls à mon avis : pour ma part j'utilise "*.xls" pour ce type de recherche

J'ai également add "*.xls" dans la fin do code de Theze. Je ne suis pas sure qu'il le fallait maintenant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Function RecupFichiers(Chemin As String, Extension As String, Retour As Integer) As String()
 
    Dim TableauFichiers() As String
    Dim Fichier As String
    Dim I As Integer
 
    Fichier = Dir(Chemin & "*.xls" & Extension)

[Theze]

Re,

Il y a quelque chose qui m'interpelle, dans ton image je vois que l'adresse dans l'explorateur est "C:\Users\ ABC \Documents\xyz\shippings" et dans ton post tu indique "C:\Users\ABC\Documents\XYZ\shippings\" sans les espaces dans la partie ABC ?
Je pense que pour le test il faudrait, soit que tu copie l'adresse de ton dossier depuis la barre d'adresse de l'explorateur, soit que tu copie quelques classeurs dans un dossier test situé directement à la racine comme par exemple "C:\Test\" car je crois bien que le problème vient d'une mauvaise adresse de dossier !

Hervé.

[panzera]

Au fait j'ai modifié l'image pour ne pas montrer l'adresse réelle où ABC serait le nom de l'entreprise pour laquelle je travaille e XYZ est mon client...
Effectivement j'avais fait copier + coller de l’adresse de l'explorateur, je pense qu'il doit avoir une autre explication.
Dans le code, vous avez utilisé un "I" qui n'est pas sur la ligne:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

TblClasseur = RecupFichiers(Chemin, "*.xls", J)

L'erreur ne viendrait pas de là?

[Theze]

Bonjour,

Dans "RecupValeurs", la variable I est utilisée pour boucler sur les différents classeurs retournés et dans "RecupFichiers" elle sert à la construction du tableau et je m'en sert aussi pour retourner le nombre de classeurs trouvés.

Hervé.