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
| Sub Actualisation()
' Microsoft ActiveX DataObject doit être coché
Dim LesLignes
Dim I As Integer, J As Integer, K As Integer
Dim Cnn As Object, Rs As Object
Dim Tbl
Dim Somme()
Application.ScreenUpdating = False
If Sheets("Sommaire").Range("B4") = "[Choisir votre section]" Then
Exit Sub
Else
Sheets("Sommaire").Unprotect "essai"
M_A_J.Show vbModeless 'affiche l'userform nommé "patience"
M_A_J.Repaint 'rafraichit le contenu à placer
'commence le traitement
ReDim Somme(1 To 312)
Chemin = ThisWorkbook.Path & "\": Feuille = "Sommaire"
LesLignes = Array(8, 10, 15, 17, 22, 24, 29, 31, 36, 38, 43, 45, 50, 52, 57, 59, 64, 66, 71, 73, 78, 80, 85, 87)
For J = LBound(LesLignes) To UBound(LesLignes)
For K = 1 To 13
Sheets("Sommaire").Cells(LesLignes(J), K).ClearContents
Next K
Next J
Fichier = Dir(Chemin & "*.xlsm")
Do While Len(Fichier) > 0
If Fichier <> ThisWorkbook.Name Then
Set Cnn = New ADODB.Connection
Cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
Chemin & Fichier & ";Extended Properties='Excel 12.0;HDR=No'"
Set Rs = Cnn.Execute("[Sommaire$A1:M87]")
Tbl = Rs.GetRows
I = 1
For J = LBound(LesLignes) To UBound(LesLignes)
For K = 1 To 13
Somme(I) = CDbl(Somme(I)) + CDbl(Tbl(K - 1, LesLignes(J) - 1)): I = I + 1
Next K
Next J
Rs.Close
Cnn.Close
End If
Fichier = Dir()
Loop
Set Rs = Nothing
Set Cnn = Nothing
With Sheets("Sommaire")
I = 1
For J = LBound(LesLignes) To UBound(LesLignes)
For K = 1 To 13
.Cells(LesLignes(J), K) = Somme(I): I = I + 1
Next K
Next J
End With
Unload M_A_J 'décharge l'userform de la mémoire
End If
Sheets("Sommaire").Protect "essai"
Application.ScreenUpdating = True
End Sub |
Partager