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