Une macro synthese en VBA sous excel!

**max2245** · 26/12/2005, 22h59

Quelqu'un pourrait t-il m'aider à debueuger ce programme?

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
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.]

**SfJ5Rpw8** · 27/12/2005, 00h16

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...

**Igloobel** · 27/12/2005, 11h06

Salut max2245

Comme le dit bbil

... essai de mettre des balises ...

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

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
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 :

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

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

) path un mot connu de VBA

donc evites, à mon avis appele la plutôt "chemin" par exemple

.

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 :

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

Voilà

Igloobel

**SfJ5Rpw8** · 27/12/2005, 11h54

Envoyé par Igloobel

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

c'est pas incrémenter mais plutôt indenter

**Igloobel** · 27/12/2005, 12h43

oups

c'est vrai !
désolé

La prochaine fois je ferais plus attention à mon vocabulaire

Igloobel

**max2245** · 27/12/2005, 19h25

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 :

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
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.]

**max2245** · 27/12/2005, 19h34

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

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
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.]

**SfJ5Rpw8** · 27/12/2005, 19h38

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 :

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

**max2245** · 27/12/2005, 19h41

oui c'est ca merci et pour copier les differents fichiers
dans le fichier de synthèse tu fais comment?

**SfJ5Rpw8** · 27/12/2005, 19h42

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...

**max2245** · 27/12/2005, 19h43

Ah ok je garde mon programme original et j'insère ton petit
programme à l'intérieur c'est ca?

**SfJ5Rpw8** · 27/12/2005, 19h45

voila... tu remplace dans ton programme l'initialisation de ton tableau .

**max2245** · 27/12/2005, 19h56

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

Code :

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

 Workbooks.Open path & FilesName(i)

cela plante ici

**max2245** · 27/12/2005, 19h59

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

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

**SfJ5Rpw8** · 27/12/2005, 20h00

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 :

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

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

**max2245** · 27/12/2005, 20h06

Bon va falloir que je t'offre le champagne!

**max2245** · 27/12/2005, 20h09

Tu peux m'expliquer grosso modo pk tu fais ca?
Debig print, etc

**SfJ5Rpw8** · 27/12/2005, 20h37

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..

Une macro synthese en VBA sous excel!

Macros et VBA Excel

Discussions similaires

Partager

Partager