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
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
ton "petit programme" ... il les ouvre comment tes fichiers ...?
voici le programme qui marche!
[édité par Dark Vader - veuillez penser à utiliser les balises SVP]
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
Voir les procédure de tri... une fois le tableau rempli... FilesName(1 To nbFiles) ...
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
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?
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![]()
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)
?
tiens une fonction tri ... crée à partir du cours :
Appel à effectuer ... aprés la boucle while de remplissage ...
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
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4 ... Wend TriTableau FilesName() ....![]()
voici le programme entier il marche!
j'ai ajouté
car sur certaines versions d'excel il me demande
Code : Sélectionner tout - Visualiser dans une fenêtre à part Application.AskToUpdateLinks = False
si je veux mettre à jour ou non les liens
[Balises "Code" ajoutées par AlainTech]
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
[Pensez-y vous-même à l'avenir. Merci.]
Pour ceux que cela intéresse!
[Balises "Code" ajoutées par AlainTech]
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
[Pensez-y vous-même à l'avenir. Merci.]
SVP, veuillez lire les régles d'utilisation des forums avant que je ne verrouille ce topic.
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
Vous avez un bloqueur de publicités installé.
Le Club Developpez.com n'affiche que des publicités IT, discrètes et non intrusives.
Afin que nous puissions continuer à vous fournir gratuitement du contenu de qualité, merci de nous soutenir en désactivant votre bloqueur de publicités sur Developpez.com.
Partager