Ouverture de fichiers excel par ordre alphabetique

**max2245** · 30/12/2005, 12h09

Bonjour,

j'ai fait un petit programme sous VBA qui m'ouvre des fichiers
excel sous le meme repertoire; mais j'aimerais qu'ils me les ouvrent
par ordre alphabétique!

Pouvez vous me dire l'appliacation à utiliser avec VBA!?
Merci

**SfJ5Rpw8** · 30/12/2005, 12h12

ton "petit programme" ... il les ouvre comment tes fichiers ...?

**max2245** · 30/12/2005, 12h14

voici le programme qui marche!

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
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
Public Sub editSynthese() 
 
    Dim j, row_deb, row_fin As Integer 
 
    Dim path As String 
    Dim Strg_2 As String 
    Dim Strg_4 As String 
    Dim Strg_5 As String 
 
    Strg_2 = "Anomalies détectées :" 
    Strg_4 = "Synthèse :" 
    Strg_5 = "Fin Synthèse" 
 
    Dim nbFiles As Integer 
    Dim FilesName() As String 
    Dim st As String 
    nbFiles = 0 
 
    ' emplacement des fichiers dans le répertoire racine 
 
 
    path = ThisWorkbook.path 
    st = Dir(path & "\*.xls") 
    While st <> "" 
     If st <> ThisWorkbook.Name Then 
        nbFiles = nbFiles + 1 
        ReDim Preserve FilesName(1 To nbFiles) As String 
        FilesName(nbFiles) = st 
        Debug.Print "Rajout Fichier  : " & st 
      Else 
       Debug.Print "Fichier courant" & st & " ignoré" 
      End If 
     st = Dir 
     DoEvents 
     Wend 
 
 
 
 
 
 
    'ouverture des fichiers 
    Application.DisplayAlerts = False 
    For i = 1 To nbFiles 
        Workbooks.Open path & "\" & FilesName(i) 
    Next i 
 
    j = 1 
 
    ' copie des "Evénements importants" dans fichier cabinet 
    For i = 1 To nbFiles 
 
        Workbooks(FilesName(i)).Activate 
        Worksheets(1).Activate 
 
        row_deb = 1 
        While Worksheets(1).Cells(row_deb, 1) <> Strg_4 
           row_deb = row_deb + 1 
        Wend 
 
        row_fin = row_deb + 1 
        While Worksheets(1).Cells(row_fin, 1) <> Strg_2 
           row_fin = row_fin + 1 
        Wend 
 
        Workbooks("Synthese.xls").Worksheets(1).Cells(j, 1) = Worksheets(1).Cells(row_deb, 1) & Left(FilesName(i), Len(FilesName(i)) - 4) 
        j = j + 1 
        For k = row_deb + 1 To row_fin - 1 
            Workbooks("Synthese.xls").Worksheets(1).Cells(j, 1) = Worksheets(1).Cells(k, 1) 
            j = j + 1 
        Next k 
 
    Next i 
 
     ' copie des "Anomalies détectées" dans fichier cabinet 
 
 
    j = j + 2 
 
    For i = 1 To nbFiles 
 
        Workbooks(FilesName(i)).Activate 
        Worksheets(1).Activate 
 
        row_deb = 1 
        While Worksheets(1).Cells(row_deb, 1) <> Strg_2 
           row_deb = row_deb + 1 
        Wend 
 
        row_fin = row_deb + 1 
        While Worksheets(1).Cells(row_fin, 1) <> Strg_5 
           row_fin = row_fin + 1 
        Wend 
 
        Workbooks("Synthese.xls").Worksheets(1).Cells(j, 1) = Worksheets(1).Cells(row_deb, 1) & Left(FilesName(i), Len(FilesName(i)) - 4) 
        j = j + 1 
        For k = row_deb + 1 To row_fin - 1 
            Workbooks("Synthese.xls").Worksheets(1).Cells(j, 1) = Worksheets(1).Cells(k, 1) 
            j = j + 1 
        Next k 
 
    Next i 
 
    ' copie des "Anomalies détectées" dans fichier client 
    j = 1 
 
     For i = 1 To nbFiles 
 
        Workbooks(i + 1).Activate 
        Worksheets(1).Activate 
 
        row_deb = 1 
        While Worksheets(1).Cells(row_deb, 1) <> Strg_2 
           row_deb = row_deb + 1 
        Wend 
 
        row_fin = row_deb + 1 
        While Worksheets(1).Cells(row_fin, 1) <> Strg_5 
           row_fin = row_fin + 1 
        Wend 
 
        Workbooks("Synthese.xls").Worksheets(2).Cells(j, 1) = Worksheets(1).Cells(row_deb, 1) & Left(FilesName(i), Len(FilesName(i)) - 4) 
        j = j + 1 
        For k = row_deb + 1 To row_fin - 1 
            Workbooks("Synthese.xls").Worksheets(2).Cells(j, 1) = Worksheets(1).Cells(k, 1) 
            j = j + 1 
        Next k 
 
    Next i 
 
     'fermeture des fichiers 
    ScreenUpdating = False 
    For i = 1 To nbFiles 
        Workbooks(FilesName(i)).Close 
    Next i 
 
 
End Sub

[édité par Dark Vader - veuillez penser à utiliser les balises SVP]

**SfJ5Rpw8** · 30/12/2005, 12h16

Voir les procédure de tri... une fois le tableau rempli... FilesName(1 To nbFiles) ...

**max2245** · 30/12/2005, 12h17

C'st à ce niveau là que j'aimerais qu'il m'ouvre les fichiers
dans mon répertoire racine par ordre alphabetique
et pas de manière aléatoire, car lorsque je lance ma macro
editsynthese, il me cree copies les differentes syntheses
de maniere alétoire, tu vois le problème?

'ouverture des fichiers
Application.DisplayAlerts = False
For i = 1 To nbFiles
Workbooks.Open path & "\" & FilesName(i)
Next i

**max2245** · 30/12/2005, 12h19

JE sais bien qu'il faut trier!
IL faudrait créer un tableau qui stocke les noms des fiochers
par ordre alphabétique, tu fais ca comment?

**SfJ5Rpw8** · 30/12/2005, 12h20

une fois le tableau rempli ... par des dir ... trie le en utilisant par exemple la méthode décrite ici :

http://plasserre.developpez.com/ve1-3.htm

**max2245** · 30/12/2005, 12h28

ok je vois tu me conseilles la methode sort ou framework,
Pour un tableau unidimensionnel.

Dim Animals(2) As String
Animals(0) = "lion"
Animals(1) = "girafe"
Animals(2) = "loup"
Array.Sort(Animals)

?

**SfJ5Rpw8** · 30/12/2005, 12h35

tiens une fonction tri ... crée à partir du cours :

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
Sub TriTableau(T() As String)
Dim i, j, N   As Integer    'Variable de boucle i, j ; N= nombre d'éléments-1
Dim Min As Integer
Dim Temp  As String
 
N = UBound(T)  '
Min = LBound(T)
 
For i = Min To N
 
    For j = Min To N - 1
 
        If UCase(T(j)) > UCase(T(j + 1)) Then
 
            Temp = T(j): T(j) = T(j + 1): T(j + 1) = Temp
 
        End If
 
    Next j
 
 Next i
End Sub

Appel à effectuer ... aprés la boucle while de remplissage ...

Code :

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

1
2
3
4
...
Wend
TriTableau FilesName()
....

**max2245** · 30/12/2005, 12h47

voici le programme entier il marche!

j'ai ajouté

Code :

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

Application.AskToUpdateLinks = False

car sur certaines versions d'excel il me demande
si je veux mettre à jour ou non les liens

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
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
' trier un tableau par ordre alphabétique
 
Sub TriTableau(T() As String)
Dim i, j, N   As Integer    'Variable de boucle i, j ; N= nombre d'éléments-1
Dim Min As Integer
Dim Temp  As String
 
N = UBound(T)  '
Min = LBound(T)
 
For i = Min To N
 
    For j = Min To N - 1
 
        If UCase(T(j)) > UCase(T(j + 1)) Then
 
            Temp = T(j): T(j) = T(j + 1): T(j + 1) = Temp
 
        End If
 
    Next j
 
 Next i
End Sub
 
 
Public Sub editSynthese()
 
    Dim j, row_deb, row_fin As Integer
 
    Dim path As String
    Dim Strg_2 As String
    Dim Strg_4 As String
    Dim Strg_5 As String
 
    Strg_2 = "Anomalies détectées :"
    Strg_4 = "Synthèse :"
    Strg_5 = "Fin Synthèse"
 
    Dim nbFiles As Integer
    Dim FilesName() As String
    Dim st As String
    nbFiles = 0
 
    ' triage des tableaux par ordre alphabétique
 
    TriTableau FilesName()
 
 
    ' emplacement des fichiers dans le répertoire racine
 
 
    path = ThisWorkbook.path
    st = Dir(path & "\*.xls")
    While st <> ""
     If st <> ThisWorkbook.Name Then
        nbFiles = nbFiles + 1
        ReDim Preserve FilesName(1 To nbFiles) As String
        FilesName(nbFiles) = st
        Debug.Print "Rajout Fichier  : " & st
      Else
       Debug.Print "Fichier courant" & st & " ignoré"
      End If
     st = Dir
     DoEvents
     Wend
 
    'ouverture des fichiers
    Application.AskToUpdateLinks = False
    Application.DisplayAlerts = False
    For i = 1 To nbFiles
         Workbooks.Open path & "\" & FilesName(i)
 
    Next i
 
    j = 1
 
    ' copie des "Evénements importants" dans fichier cabinet
    For i = 1 To nbFiles
 
        Workbooks(FilesName(i)).Activate
        Worksheets(1).Activate
 
        row_deb = 1
        While Worksheets(1).Cells(row_deb, 1) <> Strg_4
           row_deb = row_deb + 1
        Wend
 
        row_fin = row_deb + 1
        While Worksheets(1).Cells(row_fin, 1) <> Strg_2
           row_fin = row_fin + 1
        Wend
 
        Workbooks(ThisWorkbook.Name).Worksheets(1).Cells(j, 1) = Worksheets(1).Cells(row_deb, 1) & Left(FilesName(i), Len(FilesName(i)) - 4)
        j = j + 1
        For k = row_deb + 1 To row_fin - 1
            Workbooks(ThisWorkbook.Name).Worksheets(1).Cells(j, 1) = Worksheets(1).Cells(k, 1)
            j = j + 1
        Next k
 
    Next i
 
     ' copie des "Anomalies détectées" dans fichier cabinet
 
 
    j = j + 2
 
    For i = 1 To nbFiles
 
        Workbooks(FilesName(i)).Activate
        Worksheets(1).Activate
 
        row_deb = 1
        While Worksheets(1).Cells(row_deb, 1) <> Strg_2
           row_deb = row_deb + 1
        Wend
 
        row_fin = row_deb + 1
        While Worksheets(1).Cells(row_fin, 1) <> Strg_5
           row_fin = row_fin + 1
        Wend
 
        Workbooks(ThisWorkbook.Name).Worksheets(1).Cells(j, 1) = Worksheets(1).Cells(row_deb, 1) & Left(FilesName(i), Len(FilesName(i)) - 4)
        j = j + 1
        For k = row_deb + 1 To row_fin - 1
            Workbooks(ThisWorkbook.Name).Worksheets(1).Cells(j, 1) = Worksheets(1).Cells(k, 1)
            j = j + 1
        Next k
 
    Next i
 
    ' copie des "Anomalies détectées" dans fichier client
    j = 1
 
     For i = 1 To nbFiles
 
        Workbooks(i + 1).Activate
        Worksheets(1).Activate
 
        row_deb = 1
        While Worksheets(1).Cells(row_deb, 1) <> Strg_2
           row_deb = row_deb + 1
        Wend
 
        row_fin = row_deb + 1
        While Worksheets(1).Cells(row_fin, 1) <> Strg_5
           row_fin = row_fin + 1
        Wend
 
        Workbooks(ThisWorkbook.Name).Worksheets(2).Cells(j, 1) = Worksheets(1).Cells(row_deb, 1) & Left(FilesName(i), Len(FilesName(i)) - 4)
        j = j + 1
        For k = row_deb + 1 To row_fin - 1
            Workbooks(ThisWorkbook.Name).Worksheets(2).Cells(j, 1) = Worksheets(1).Cells(k, 1)
            j = j + 1
        Next k
 
    Next i
 
     'fermeture des fichiers
    ScreenUpdating = False
    For i = 1 To nbFiles
        Workbooks(FilesName(i)).Close
    Next i
 
 
End Sub

[Balises "Code" ajoutées par AlainTech]
[Pensez-y vous-même à l'avenir. Merci. ]

**max2245** · 30/12/2005, 16h28

Pour ceux que cela intéresse!

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
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
' trier un tableau par ordre alphabétique
 
Sub TriTableau(T() As String)
Dim i, j, N   As Integer    'Variable de boucle i, j ; N= nombre d'éléments-1
Dim Min As Integer
Dim Temp  As String
 
N = UBound(T) '
Min = LBound(T)
 
For i = Min To N
 
    For j = Min To N - 1
 
        If UCase(T(j)) > UCase(T(j + 1)) Then
 
            Temp = T(j): T(j) = T(j + 1): T(j + 1) = Temp
 
        End If
 
    Next j
 
 Next i
End Sub
 
 
Public Sub editSynthese()
 
    Dim j, row_deb, row_fin As Integer
 
    Dim path As String
    Dim Strg_2 As String
    Dim Strg_4 As String
    Dim Strg_5 As String
 
    Strg_2 = "Anomalies détectées :"
    Strg_4 = "Synthèse :"
    Strg_5 = "Fin Synthèse"
 
    Dim nbFiles As Integer
    Dim FilesName() As String
    Dim st As String
    nbFiles = 0
 
 
 
    ' emplacement des fichiers dans le répertoire racine
 
 
    path = ThisWorkbook.path
    st = Dir(path & "\*.xls")
    While st <> ""
     If st <> ThisWorkbook.Name Then
        nbFiles = nbFiles + 1
        ReDim Preserve FilesName(1 To nbFiles) As String
        FilesName(nbFiles) = st
        Debug.Print "Rajout Fichier  : " & st
      Else
       Debug.Print "Fichier courant" & st & " ignoré"
      End If
     st = Dir
     DoEvents
     Wend
 
 
    ' triage des tableaux par ordre alphabétique
 
    TriTableau FilesName()
 
 
    'ouverture des fichiers
 
    Application.AskToUpdateLinks = False
    Application.DisplayAlerts = False
    For i = 1 To nbFiles
         Workbooks.Open path & "\" & FilesName(i)
 
    Next i
 
    j = 1
 
    ' copie des "Evénements importants" dans fichier cabinet
 
    For i = 1 To nbFiles
 
        Workbooks(FilesName(i)).Activate
        Worksheets(1).Activate
 
        row_deb = 1
        While Worksheets(1).Cells(row_deb, 1) <> Strg_4
           row_deb = row_deb + 1
        Wend
 
        row_fin = row_deb + 1
        While Worksheets(1).Cells(row_fin, 1) <> Strg_2
           row_fin = row_fin + 1
        Wend
 
        Workbooks(ThisWorkbook.Name).Worksheets(1).Cells(j, 1) = Worksheets(1).Cells(row_deb, 1) & Left(FilesName(i), Len(FilesName(i)) - 4)
        j = j + 1
        For k = row_deb + 1 To row_fin - 1
            Workbooks(ThisWorkbook.Name).Worksheets(1).Cells(j, 1) = Worksheets(1).Cells(k, 1)
            j = j + 1
        Next k
 
    Next i
 
     ' copie des "Anomalies détectées" dans fichier cabinet
 
 
    j = j + 2
 
    For i = 1 To nbFiles
 
        Workbooks(FilesName(i)).Activate
        Worksheets(1).Activate
 
        row_deb = 1
        While Worksheets(1).Cells(row_deb, 1) <> Strg_2
           row_deb = row_deb + 1
        Wend
 
        row_fin = row_deb + 1
        While Worksheets(1).Cells(row_fin, 1) <> Strg_5
           row_fin = row_fin + 1
        Wend
 
        Workbooks(ThisWorkbook.Name).Worksheets(1).Cells(j, 1) = Worksheets(1).Cells(row_deb, 1) & Left(FilesName(i), Len(FilesName(i)) - 4)
        j = j + 1
        For k = row_deb + 1 To row_fin - 1
            Workbooks(ThisWorkbook.Name).Worksheets(1).Cells(j, 1) = Worksheets(1).Cells(k, 1)
            j = j + 1
        Next k
 
    Next i
 
    ' copie des "Anomalies détectées" dans fichier client
 
    j = 1
 
     For i = 1 To nbFiles
 
        Workbooks(i + 1).Activate
        Worksheets(1).Activate
 
        row_deb = 1
        While Worksheets(1).Cells(row_deb, 1) <> Strg_2
           row_deb = row_deb + 1
        Wend
 
        row_fin = row_deb + 1
        While Worksheets(1).Cells(row_fin, 1) <> Strg_5
           row_fin = row_fin + 1
        Wend
 
        Workbooks(ThisWorkbook.Name).Worksheets(2).Cells(j, 1) = Worksheets(1).Cells(row_deb, 1) & Left(FilesName(i), Len(FilesName(i)) - 4)
        j = j + 1
        For k = row_deb + 1 To row_fin - 1
            Workbooks(ThisWorkbook.Name).Worksheets(2).Cells(j, 1) = Worksheets(1).Cells(k, 1)
            j = j + 1
        Next k
 
    Next i
 
     'fermeture des fichiers
 
    ScreenUpdating = False
    For i = 1 To nbFiles
        Workbooks(FilesName(i)).Close
    Next i
 
 
End Sub

[Balises "Code" ajoutées par AlainTech]
[Pensez-y vous-même à l'avenir. Merci.]

**DarkVader** · 30/12/2005, 16h36

SVP, veuillez lire les régles d'utilisation des forums avant que je ne verrouille ce topic.

**DarkVader** · 30/12/2005, 16h54

En plus court

Code :

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

1
2
3
4
5
6
7
8
9
10
11
    With Application.FileSearch
        .LookIn = "C:\DOCS"
        .FileType = msoFileTypeExcelWorkbooks
        .SearchSubFolders = False
        .Execute msoSortByFileName, msoSortOrderAscending
        If .FoundFiles.Count > 0 Then
            For Each f In .FoundFiles
                Debug.Print f   ' ou traitement(f)
            Next
        End If
    End With

Ouverture de fichiers excel par ordre alphabetique

Macros et VBA Excel

Discussions similaires

Partager

Partager