Une macro synthese en VBA sous excel!

Version imprimable

Quelqu'un pourrait t-il m'aider à debueuger ce 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
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
Function Filesname(sPath As String)
  Dim v() As String
 
  v = Split(sPath, "\")
  Filesname = v(UBound(v))
 
End Function
 
 
Public Sub editSynthese()
 
  Dim j, row_deb, row_fin As Integer
  Dim compteur As Long
  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 LFIF() As Variant
 
 
  'Choix du chemin
  path = ActiveWorkbook.path
  'mise en place de la liste de fichiers
  With Application.FileSearch
    .NewSearch
    .FileType = msoFileTypeExcelWorkbooks
    .SearchSubFolders = False
    .LookIn = ActiveWorkbook.path
    If .Execute() > 1 Then
      a = 0
      ReDim Preserve LFIF(.FoundFiles.Count - 1)
      '(-1) car array(0) (-1) car ce fichier est déjà ouvert
      compteur = .FoundFiles.Count
      For i = 1 To compteur
        If .FoundFiles(i) <> ActiveWorkbook.FullName Then
          LFIF(a) = .FoundFiles(i)
          MsgBox LFIF(a)
          Worksheets(1).Cells(i, 1) = .FoundFiles(i)
 
          MsgBox Filesname(.FoundFiles(i))
 
          'ouverture des fichiers
 
          Application.DisplayAlerts = False
          Workbooks.Open LFIF(a)
 
          a = a + 1
 
        End If
 
        ' copie des "Evénements importants" dans fichier cabinet
 
        j = 1
 
        Workbooks(Filesname(.FoundFiles(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(ActiveWorkbook.FullName).Worksheets(1).Cells(j, 1) = Worksheets(1).Cells(row_deb, 1) & left(Filesname(.FoundFiles(i)), len(Filesname(.FoundFiles(i)) - 4)
        j = j + 1
        For k = row_deb + 1 To row_fin - 1
          Workbooks(ActiveWorkbook.FullName).Worksheets(1).Cells(j, 1) = Worksheets(1).Cells(k, 1)
          j = j + 1
        Next k
      Next i
    Else
      MsgBox ("Aucun autre fichier que celui-ci")
    End If                 
 
  End With   
 
  ' copie des "Anomalies détectées" dans fichier cabinet
 
 
  j = j + 2
 
  For i = 1 To compteur
 
    Workbooks(ActiveWorkbook.FullName).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(ActiveWorkbook.FullName).Worksheets(1).Cells(j, 1) = Worksheets(1).Cells(row_deb, 1) & Left(LFIF(i), Len(LFIF(i)) - 4)
    j = j + 1
    For k = row_deb + 1 To row_fin - 1
      Workbooks(ActiveWorkbook.FullName).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 compteur
 
    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(ActiveWorkbook.FullName).Worksheets(2).Cells(j, 1) = Worksheets(1).Cells(row_deb, 1) & Left(LFIF(i), Len(LFIF(i)) - 4)
    j = j + 1
    For k = row_deb + 1 To row_fin - 1
      Workbooks(ActiveWorkbook.FullName).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(LFIF(i)).Close
  Next i
 
End Sub

[Balises "Code" ajoutées par AlainTech]
[Merci d'y penser à l'avenir.]

27/12/2005, 00h16
SfJ5Rpw8

essai de mettre des balises ( bouton code ... sur fenêtre saisie du message ...) et de nous dire ou tu as des problémes et de nous décrire ce qu'est censé faire ta macro... :wink:

Salut max2245

Comme le dit bbil

Citation:

... essai de mettre des balises ...

et comme c'est Noël je l'ai fait pour toi voici ce que j'obtiens :

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
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
Function Filesname(sPath As String)
    Dim v() As String
    v = Split(sPath, "\")
    Filesname = v(UBound(v))
End Function
 
Public Sub editSynthese()
 
    Dim j, row_deb, row_fin As Integer
    Dim compteur As Long
    Dim LFIF() As Variant
    Dim path, Strg_2, Strg_4, Strg_5 As String
 
    Strg_2 = "Anomalies détectées :"
    Strg_4 = "Synthèse :"
    Strg_5 = "Fin Synthèse"
 
    'Choix du chemin
    path = ActiveWorkbook.path
 
    'mise en place de la liste de fichiers
    With Application.FileSearch
        .NewSearch
        .FileType = msoFileTypeExcelWorkbooks
        .SearchSubFolders = False
        .LookIn = ActiveWorkbook.path
        If .Execute() > 1 Then
            a = 0
            ReDim Preserve LFIF(.FoundFiles.Count - 1)
            '(-1) car array(0) (-1) car ce fichier est déjà ouvert
            compteur = .FoundFiles.Count
            For i = 1 To compteur
                If .FoundFiles(i) <> ActiveWorkbook.FullName Then
                    LFIF(a) = .FoundFiles(i)
                    MsgBox LFIF(a)
                    Worksheets(1).Cells(i, 1) = .FoundFiles(i)
 
                    MsgBox Filesname(.FoundFiles(i))
 
                    'ouverture des fichiers
 
                    Application.DisplayAlerts = False
                    Workbooks.Open LFIF(a)
                    a = a + 1
                Else
                End If
 
                ' copie des "Evénements importants" dans fichier cabinet
 
                j = 1
 
                Workbooks(Filesname(.FoundFiles(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(ActiveWorkbook.FullName).Worksheets(1).Cells(j, 1) = Worksheets(1).Cells(row_deb, 1) & Left(Filesname(.FoundFiles(i)), Len(Filesname(.FoundFiles(i)) - 4))
                j = j + 1
                For k = row_deb + 1 To row_fin - 1
                    Workbooks(ActiveWorkbook.FullName).Worksheets(1).Cells(j, 1) = Worksheets(1).Cells(k, 1)
                    j = j + 1
                Next k
 
            Next i
 
        Else
            MsgBox ("Aucun autre fichier que celui-ci")
        End If
 
 
    End With
 
    ' copie des "Anomalies détectées" dans fichier cabinet
 
 
    j = j + 2
 
    For i = 1 To compteur
 
        Workbooks(ActiveWorkbook.FullName).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(ActiveWorkbook.FullName).Worksheets(1).Cells(j, 1) = Worksheets(1).Cells(row_deb, 1) & Left(LFIF(i), Len(LFIF(i)) - 4)
        j = j + 1
        For k = row_deb + 1 To row_fin - 1
            Workbooks(ActiveWorkbook.FullName).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 compteur
 
        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(ActiveWorkbook.FullName).Worksheets(2).Cells(j, 1) = Worksheets(1).Cells(row_deb, 1) & Left(LFIF(i), Len(LFIF(i)) - 4)
        j = j + 1
        For k = row_deb + 1 To row_fin - 1
            Workbooks(ActiveWorkbook.FullName).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(LFIF(i)).Close
    Next i
 
End Sub

La prochaine fois essaye d'incrémenter comme tu le vois c'est plus lisible et réduit les groupes de lignes blanches à une.

Lorsque j'ai prit ton code pour l'incrémenter j'ai eu une erreur sur la ligne

Code:

Workbooks(ActiveWorkbook.FullName).Worksheets(1).Cells(j, 1) = Worksheets(1).Cells(row_deb, 1) & left(Filesname(.FoundFiles(i)), len(Filesname(.FoundFiles(i)) - 4)

Il manque à la fin une parentèse :?
(Dans le code si dessus je l'ai ajoutée)

De plus tu utilises une variable : "path" (qui d'ailleur, une fois renseignée, je ne vois pas où tu l'utilises 8O ) path un mot connu de VBA :evil: donc evites, à mon avis appele la plutôt "chemin" par exemple :wink: .

Voilà déjà regarde ces deux remarques et dis si c'est suffisant ou pas

Et si ça l'est pas, et bien comme le dis bbil :

Citation:

... et de nous dire ou tu as des problémes et de nous décrire ce qu'est censé faire ta macro... :wink:

Voilà

Igloobel

27/12/2005, 11h54
SfJ5Rpw8

Citation:

Envoyé par Igloobel

La prochaine fois essaye d'incrémenter comme tu le vois c'est plus lisible

:wink: c'est pas incrémenter mais plutôt indenter :P
27/12/2005, 12h43
Igloobel

oups :oops: c'est vrai !
désolé :?
La prochaine fois je ferais plus attention à mon vocabulaire :cry:

Igloobel

Le programme avec des fichiers statiques

Voici le programme que j'ai fait!
Le but de ce programme est d'ouvrir des fichiers
et de faire la synthèse dans un fichier synthèse.
Le seul problème de ce programme est qu'il faut indiquer
le chemin dans le répertoire racine et les noms des fichiers.

Je souhaiterais faire un programme dynamique qui va chercher les
fichiers dans le même répertoire racine.

Quelqu'un peut il m'aideR?

Merci pour vos réponses!

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
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
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
 
  nbFiles = 12
  ReDim FilesName(1 To nbFiles) As String
 
  ' emplacement des fichiers
  path = "C:\Documents and Settings\fraysse\Mes documents\Maxime\Enoes\Cabinet Elkaim\"
 
  ' liste des noms de fichiers à synthétiser
  FilesName(1) = "G- Capitaux.xls"
  FilesName(2) = "H- Emprunts.xls"
  FilesName(3) = "I- Immo corporelles et incorporelles.xls"
  FilesName(4) = "J- Immofinancières.xls"
  FilesName(5) = "K- Stocks.xls"
  FilesName(6) = "L- Fournisseurs.xls"
  FilesName(7) = "M- Clients.xls"
  FilesName(8) = "N - Personnels.xls"
  FilesName(9) = "O- Impôts et taxes.xls"
  FilesName(10) = "Q- Comptes courants.xls"
  FilesName(11) = "R- Débiteurs et créditeurs divers.xls"
  FilesName(12) = "ST- Charges constatées d'avance et produits à recevoir.xls"
 
  'ouverture des fichiers
 
  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

[Balises "Code" ajoutées par AlainTech]
[Merci d'y penser à l'avenir.]

suite ce que je voudrais avoir!

En fait je voudrais obtenir un programme de ce type sauf que
cela bugue lorque je fais les copies dans le fichier actif!

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
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
Function Filesname(sPath As String)
    Dim v() As String
    v = Split(sPath, "\")
    Filesname = v(UBound(v))
End Function
 
Public Sub editSynthese()
 
    Dim j, row_deb, row_fin As Integer
    Dim compteur As Long
    Dim LFIF() As Variant
    Dim chemin, Strg_2, Strg_4, Strg_5 As String
 
    Strg_2 = "Anomalies détectées :"
    Strg_4 = "Synthèse :"
    Strg_5 = "Fin Synthèse"
 
    'Choix du chemin
    chemin = ActiveWorkbook.path
 
    'mise en place de la liste de fichiers
    With Application.FileSearch
        .NewSearch
        .FileType = msoFileTypeExcelWorkbooks
        .SearchSubFolders = False
        .LookIn = ActiveWorkbook.path
        If .Execute() > 1 Then
            a = 0
            ReDim Preserve LFIF(.FoundFiles.Count - 1)
            '(-1) car array(0) (-1) car ce fichier est déjà ouvert
            compteur = .FoundFiles.Count
            For i = 1 To compteur
                If .FoundFiles(i) <> ActiveWorkbook.FullName Then
                    LFIF(a) = .FoundFiles(i)
           '         MsgBox LFIF(a)
            '        Worksheets(1).Cells(i, 1) = .FoundFiles(i)
 
           '         MsgBox Filesname(.FoundFiles(i))
 
                    'ouverture des fichiers
 
                    Application.DisplayAlerts = False
                    Workbooks.Open LFIF(a)
                    a = a + 1
                Else
                End If
 
                ' copie des "Evénements importants" dans fichier cabinet
 
                j = 1
 
                Workbooks(Filesname(.FoundFiles(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(ActiveWorkbook.FullName).Worksheets(1).Cells(j, 1) = Worksheets(1).Cells(row_deb, 1) & Left(LFIF(i), Len(LFIF(i)) - 4)
                j = j + 1
                For k = row_deb + 1 To row_fin - 1
                    Workbooks(ActiveWorkbook.FullName).Worksheets(1).Cells(j, 1) = Worksheets(1).Cells(k, 1)
                    j = j + 1
                Next k
 
            Next i
 
        Else
            MsgBox ("Aucun autre fichier que celui-ci")
        End If
 
 
    End With
 
    ' copie des "Anomalies détectées" dans fichier cabinet
 
 
    j = j + 2
 
    For i = 1 To compteur
 
        Workbooks(ActiveWorkbook.FullName).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(ActiveWorkbook.FullName).Worksheets(1).Cells(j, 1) = Worksheets(1).Cells(row_deb, 1) & Left(LFIF(i), Len(LFIF(i)) - 4)
        j = j + 1
        For k = row_deb + 1 To row_fin - 1
            Workbooks(ActiveWorkbook.FullName).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 compteur
 
        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(ActiveWorkbook.FullName).Worksheets(2).Cells(j, 1) = Worksheets(1).Cells(row_deb, 1) & Left(LFIF(i), Len(LFIF(i)) - 4)
        j = j + 1
        For k = row_deb + 1 To row_fin - 1
            Workbooks(ActiveWorkbook.FullName).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(LFIF(i)).Close
    Next i
 
End Sub

[Balises "Code" ajoutées par AlainTech]
[Merci d'y penser à l'avenir.]

tiens si j'ai bien compris tu ve parcourir automatiquement la liste des fichiers présent sur le même répertoire que ton classeur de synthése qui contient cette macro ..: voici le code pour initialiser ton tableau "FilesName"

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Dim FilesName() As String
Dim nbFiles As Integer
Dim st As String
nbFiles = 0
' emplacement des fichiers '  Répertoire Racine ? le répertoire du fichier macro?
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

:roll: :wink:

27/12/2005, 19h41
max2245

oui c'est ca merci et pour copier les differents fichiers
dans le fichier de synthèse tu fais comment?
27/12/2005, 19h42
SfJ5Rpw8

ben le reste de ta macro... ( que j'ai juste lu en travers..) ne change pas ... ..tu effectue toujour ta boucle for i = 1 to nbFiles... :wink:
27/12/2005, 19h43
max2245

suite

Ah ok je garde mon programme original et j'insère ton petit
programme à l'intérieur c'est ca?
27/12/2005, 19h45
SfJ5Rpw8

voila... tu remplace dans ton programme l'initialisation de ton tableau .
27/12/2005, 19h56
max2245

plantage

En fait il manque un \ avant le nom de mon fichier

Code:

Workbooks.Open path & FilesName(i)

cela plante ici

voici le 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
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

[Balises "Code" ajoutées par AlainTech]
[Merci d'y penser à l'avenir.]

27/12/2005, 20h00
SfJ5Rpw8

Re: plantage

Citation:

Envoyé par max2245

En fait il manque un \ avant le nom de mon fichier

Workbooks.Open path & FilesName(i)

cela plante ici

et bien tu rajoute le \ ...

Code:

Workbooks.Open path & "\" & FilesName(i)

:wink:
27/12/2005, 20h06
max2245

Cool ca marche dans tous les repertoires

Bon va falloir que je t'offre le champagne!
27/12/2005, 20h09
max2245

C'est quoi le debug print?

Tu peux m'expliquer grosso modo pk tu fais ca?
Debig print, etc
27/12/2005, 20h37
SfJ5Rpw8

non c'est debug.print... , tu peu supprimer ces lignes... mais elles sont pratique pour debuggage.. le texte est affiché dans fenêtre Exécution de VBA.. :wink: