Discussion :

[jpvba65]

Bonjour à tous et toutes

J'essaye avec la macro ci dessous de récupérer dans un classeur Tri divers infos dans plusieurs classeurs fermés.

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
Sub Tri()
Dim objShell As Object
Dim objFolder As Object
Dim Chemin As String
Dim Fichier As String
 
 
    Cells.Select
    Selection.ClearContents
Chemin = "C:\Users\JP\Desktop\Test\"
'Choix du 1er fichier
   Fichier = Dir(Chemin & "*.xlsx")
'on boucle sur tous les fichiers excel du répertoire choisi
   Do While Len(Fichier) > 0
      If Fichier <> ThisWorkbook.Name Then
            With Sheets("Feuil1")
 
'Inscrit le nom des fichiers en colonne A
               Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = _
               Fichier
'Inscrit le contenu de la cellule A3 en B
               Sheets("Feuil1").Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = _
               "='" & Chemin & "[" & Fichier & "]Feuil1'!A3"
 
               Sheets("Feuil1").Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = _
               "='" & Chemin & "[" & Fichier & "]Feuil1'!A1" _
               & Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
            End With
        End If
        Fichier = Dir()
    Loop
End Sub

Pour mes essais je me contente pour l'instant d'un seul classeur avec des valeurs facilement identifiables dans mon classeur Tri.
La récupération de la dernière cellule non vide des colonnes A me pose problème.
La valeur recopiée est "Ligne 12" alors que ce devrait être "FIN"

Je joint le classeur test

Merci d'avance pour votre aide

[Daniel.C]

Bonjour,

Voici un exemple à adapter. Il est basé sur ADO. Je ne suis pas un pro donc il y a surement mieux à faire que de lire les lignes une par une, mais j'obtiens une erreur avec "MoveLast". Le résultat est contenu dans la variable "Var". Soit tu la passes en paramètre, soit tu la définis comme publique. Tu dois cocher la référence "Microsoft ActiveX Data Objects .n Library". Tu dois également passer en paramètres le chemin, nom du fichier ainsi que le nom de la feuille.

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
Sub RequeteClasseurFerme_Excel2007_1()
Dim cn As ADODB.Connection
    Dim Fichier As String
    Dim NomFeuille As String, texte_SQL As String
    Dim rst As ADODB.Recordset
    'Définit le classeur fermé servant de base de données
    Fichier = "C:\Users\Daniel\Documents\Donnees\Daniel\excel\ado\Volume.xlsx"
    'Nom de la feuille dans le classeur fermé
    NomFeuille = "Volume"
    Set cn = New ADODB.Connection
    '--- Connexion ---
    With cn
        '.Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
        & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
        .Open
        'Requête
        texte_SQL = "SELECT * FROM [" & NomFeuille & "$]"
        Set rst = New ADODB.Recordset
        rst.Open texte_SQL, cn
        Do
            Var = rst.Fields(0).Value
            rst.MoveNext
        Loop While Not rst.EOF
        '--- Fermeture connexion ---
        .Close
    End With
    Set rst = Nothing
    Set cn = Nothing
End Sub

[jpvba65]

Bonjour Daniel.C

J'ai déjà essayé des solutions avec ADO qui sont fonctionnelles sur d'autre PC
mais qui ne veulent pas fonctionner sur le mien.
Si celà peux aider d'autres personnes voici un des codes:

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
Sub Tri()
    Dim objShell As Object, objFolder As Object
    Dim Chemin As String, Fichier As String
    Dim wbkRecap As Workbook
    Dim cn As Object    'ADODB.Connection
   Dim rst As Object    'ADODB.Recordset
   Dim shtFile As String, strQuery As String
    Dim derlign As Long
 
 
    shtFile = "Sheet1"    'nom de l'onglet des différents fichiers
   Set objShell = CreateObject("Shell.Application")
    'Ouvre une fenêtre Window pour sélectionner le dossier
   Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
    'Si l'utilisateur annule sans choisir
   If objFolder Is Nothing Then
        'message
       MsgBox "Abandon opérateur", vbCritical, "Annulation"
        'sinon
   Else
        t = Timer
        Set wbkRecap = ThisWorkbook
        'Chemin = répertoire choisi
       Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
        'Choix du 1er fichier
       Fichier = Dir(Chemin & "*.xls")
 
        'spécification de la requête SQL de comptage
       'compte le nombre de lignes de la base
       strQuery = "SELECT COUNT(*) FROM [" & shtFile & "$]"
 
        'on boucle sur tous les fichiers excel du répertoire choisi
       Do While Len(Fichier) > 0
            If Fichier <> ThisWorkbook.Name Then
 
                Set cn = CreateObject("ADODB.Connection")    'late binding pour éviter l'activation de la référence ADO
 
                'initie la chaîne de connexion
               With cn
                    .Provider = "Microsoft.Jet.OLEDB.4.0"
                    .ConnectionString = "Data Source=" & Chemin & Fichier & _
                                        ";Extended Properties=Excel 8.0;"
                    .Open
                End With
 
                Set rst = cn.Execute(strQuery)
                'nombre de ligne à partir de la requête SQL prédéfinie
               derlign = rst.Fields(0).Value + 1
 
                'on vide les variables
               cn.Close
                Set rst = Nothing
                Set cn = Nothing
 
                With wbkRecap.Sheets("Feuil1")
                    'Inscrit le nom des fichiers en colonne A
                   .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Fichier
                    'Inscrit le contenu de la cellule A3 en B
                   .Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = "='" & Chemin & "[" & Fichier & "]" & shtFile & "'!A3"
                    'Inscrit le contenu de la dernière ligne de la colonne A en C
                   .Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = "='" & Chemin & "[" & Fichier & "]" & shtFile & "'!A" & derlign
                End With
 
            End If
            Fichier = Dir()
        Loop
    End If
    MsgBox Timer - t
End Sub

Je te remercie Daniel.C pour ton aide

[Marc-L]

Bonjour, bonjour,

dans le code du premier post, la formule en ligne n°26 & 27 est fausse ‼

Donc faire la formule manuellement dans une feuille test puis, une fois juste,
la comparer avec le code via un Debug.Print tout simplement …

[jpvba65]

Bonjour

Après avoir obtenu de l'aide reçu sur un autre forum, je peux comprendre mon erreur:
En fait je récupère le numéro de ligne (ligne 2 de mon fichier Tri) et je le colle à côté du A qui indique la colonne de mon fichier essai1. Ensuite je récupère le contenu de la cellule correspondante du fichier Essai1.
Ce qui bien sur n'est pas le but recherché.

Je ne désespère pas, il doit bien exister une solution.

Bonne soirée

[Daniel.C]

Bonjour,

Essaie avec ce provider (adapté aux fichiers Excel 2007) :

Code :

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

1
2
3
4
5
6
With cn
    .Provider = "Provider=Microsoft.ACE.OLEDB.12.0"
    .ConnectionString = "Data Source=" & Chemin & Fichier & _
                        ";Extended Properties=Excel 12.0;"
    .Open
End With

[Phil'oche]

Petite suggestion idiote :
Si tu as la maitrise des différents fichiers de ton répertoire (ceux sur lesquels tu vas chercher tes infos en dernière ligne), peux-être as-tu aussi la possibilité d'avoir une "Feuil2" (éventuellement masquée, voire ultra-masquée) avec une formule, dans une cellule fixe, qui permettrait d'avoir à disposition en permanence le contenu de la dernière ligne de la Feuil1 ?
Auquel cas tu pointes, dans ton classeur "Tri", directement sur cette cellule pour avoir des données à jour...

(PS : je penses que c'est toi qui maintient tous les classeurs du répertoire... car que se passe-t-il si un des classeurs ne comporte pas de Feuil1 ???)

[jpvba65]

Bonjour

Daniel-C
Le bout de code que tu as donné peux il être intégré à ma macro actuelle ?
Si oui à quel endroit.

Phil'oche
Les fichiers que je veux traiter sont créés automatiquement par un instrument de test et il n'y a toujours qu'une feuille (Feuil1).

Merci à tous les deux pour votre attention.

[Daniel.C]

Essaie comme ceci (coche la référence "Microsoft ActiveX Data Objects n.n Library") :

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
Sub Tri()
Dim objShell As Object
Dim objFolder As Object
Dim Chemin As String
Dim Fichier As String
Dim cn As Object    'ADODB.Connection
Dim Rst As Object    'ADODB.Recordset
Dim shtFile As String, strQuery As String
 
Cells.Select
Selection.ClearContents
Chemin = "C:\Users\JP\Desktop\Test\"
'Choix du 1er fichier
Fichier = Dir(Chemin & "*.xlsx")
'on boucle sur tous les fichiers excel du répertoire choisi
   Do While Len(Fichier) > 0
      If Fichier <> ThisWorkbook.Name Then
        NomFeuille = "Feuil1"
        Set cn = New ADODB.Connection
        '--- Connexion ---
        With cn
            .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & Chemin & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
            .Open
            'Requête
            texte_SQL = "SELECT * FROM [" & NomFeuille & "$]"
            Set Rst = New ADODB.Recordset
            Rst.Open texte_SQL, cn, adOpenKeyset, adLockOptimistic
            Rst.Movelast
            MsgBox Rst(0)
            '--- Fermeture connexion ---
            .Close
        End With 'Inscrit le nom des fichiers en colonne A
'        With Sheets("Feuil1")
'            .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Fichier
'            'Inscrit le contenu de la cellule A3 en B
'            .Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = _
'           "='" & Chemin & "[" & Fichier & "]Feuil1'!A3"
'
'           Sheets("Feuil1").Range("C" & Rows.Count).End(xlUp).Offset(1, 0) = _
'           "='" & Chemin & "[" & Fichier & "]Feuil1'!A1" _
'           & Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
'        End With
        End If
        Fichier = Dir()
    Loop
End Sub

PS. La dernière valeur de la colonne de chaque fichier apparaît dans un Msgbox; j'ai mis en commentaire la fin de la macro.

[jpvba65]

Merci Daniel

j'ai testé, la Msgbox indique effectivement la dernière cellule, en l’occurrence "FIN" vu que je teste pour l'instant avec un seul
classeur.
Peux on remplacer l'affichage dans la Msgbox par l'enregistrement dans une variable pour ensuite placer (si c'est possible)
cette variable à la place de mon A1.

Merci encore

[Daniel.C]

J'ai mis la valeur en colonne B vu qu'en colonne A je crois que tu mets le nom de fichier :

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
Sub Tri()
Dim objShell As Object
Dim objFolder As Object
Dim Chemin As String
Dim Fichier As String
Dim cn As Object    'ADODB.Connection
Dim Rst As Object    'ADODB.Recordset
Dim shtFile As String
Dim strQuery As String
Dim ResA3 As String
Dim ResFin As String
 
Cells.Select
Selection.ClearContents
Chemin = "C:\Users\JP\Desktop\Test\"
'Choix du 1er fichier
Fichier = Dir(Chemin & "*.xlsx")
'on boucle sur tous les fichiers excel du répertoire choisi
   Do While Len(Fichier) > 0
      If Fichier <> ThisWorkbook.Name Then
        NomFeuille = "Feuil1"
        Set cn = New ADODB.Connection
        '--- Connexion ---
        With cn
            .ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" _
            & Chemin & Fichier & ";Extended Properties=""Excel 12.0;HDR=YES;"""
            .Open
            'Requête
            texte_SQL = "SELECT * FROM [" & NomFeuille & "$]"
            Set Rst = New ADODB.Recordset
            Rst.Open texte_SQL, cn, adOpenKeyset, adLockOptimistic
            Rst.Movelast
            ResFin = Rst(0)
            '--- Fermeture connexion ---
            .Close
        End With 'Inscrit le nom des fichiers en colonne A
        With Sheets("Feuil1")
            'Inscrit le nom des fichiers en colonne A
            .Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = Fichier
            'Inscrit le contenu de la cellule A3 en B
            .Range("B" & Rows.Count).End(xlUp).Offset(1, 0) = ResFin
 
        End With
        End If
        Fichier = Dir()
    Loop
End Sub

[jpvba65]

Bonjour

Merci beaucoup Daniel pour ta macro, elle marche impeccable.
Je ne m'explique par contre pas pourquoi celle-ci fonctionne sur mon PC alors que j'ai essayé 3 autres macros utilisant ADO
qui fonctionnaient parfaitement sur d'autres PC mais qui refusaient de marcher sur le mien.

Petite question, qu-est-ce qui indique dans la macro que c'est dans la colonne A qu'il faut chercher la dernière cellule ?

Cerise sur le gâteau est il possible de rajouter un Offset lié à ResFin pour sélectionner une cellule à côté .

Encore merci Daniel

[Daniel.C]

Bonjour,

Petite question, qu-est-ce qui indique dans la macro que c'est dans la colonne A qu'il faut chercher la dernière cellule ?

Dans :

Code :

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

ResFin = Rst(0)

l'indice 0 indique la première colonne recherchée (donc A).

[jpvba65]

Bonjour

Merci Daniel pour ton aide tes solutions tes explications.
Tu m'as bien aidé et je pense que tu a aussi aidé ceux qui se sont intéressés à ce post.

Gros merci et bravo à toi