Fomat de cellules / Accélération du code

**GADENSEB** · 07/11/2015, 10h42

Hello Le Forum,

PAr le biais du code suivant, je formate les données sur une page.
Mais le code est un peu long à s’exécuter

Comment l'améliorer?

auriez-vous une idée ?

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
Sub Formats()
 
'Formatage des données
 
'Fige l'écran pendant l'éxécution de la macro
Application.ScreenUpdating = False
 
'Envoie sur la page des données
Sheets("COMPTES").Activate
 
 
 Dim n   'OK  ---- Déclare la variable n pour dénombrer les colonnes choisies dans la procédure de formatage de dates
On Error GoTo formats_Error 'OK  ---- Si erreur goto message erreur
 
With Sheets("COMPTES")
 
'Format century Gothic sur toute la BDD
.Range("A2:R" & .Range("A" & Rows.Count).End(xlUp).Row).Font.Name = _
    "Century Gothic"
'Taille Caractére 8 sur toute la BDD
.Range("A2:R" & .Range("A" & Rows.Count).End(xlUp).Row).Font.Size = 8
 
 
 
'Alignement Gauche de certaines colonnes
For Each n In Array(4, 5, 6, 7, 8, 9, 11, 12)
.Columns(n).HorizontalAlignment = xlLeft
Next n
 
'Alignement Centre de certaines colonnes
For Each n In Array(1, 2, 3, 10, 13, 14)
.Columns(n).HorizontalAlignment = xlCenter
Next n
 
'Alignement Centre de certaines colonnes
For Each n In Array(1, 2, 3, 10, 13, 14)
.Columns(n).HorizontalAlignment = xlCenter
Next n
 
'Format € de certaines colonnes
For Each n In Array(15, 16, 17, 18)
.Columns(n).NumberFormat = "#,##0.00 €"
Next n
 
'Alignement Droite de certaines colonnes
For Each n In Array(15, 16, 17, 18)
.Columns(n).HorizontalAlignment = xlRight
Next n
 
 
'Format des titres de colonnes
.Range("A1:R1").Font.Name = "Century Gothic"
.Range("A1:R1").Font.Size = 10
.Range("A1:R1").Interior.ColorIndex = 43
.Range("A1:R1").HorizontalAlignment = xlCenter
.Range("A1:R1").VerticalAlignment = xlCenter
.Range("A1:R1").NumberFormat = "General"
 
 
 
'Ajustement automatique des colonnes
For Each n In Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, _
    18)
'.Columns(n).Columns.AutoFit
Range("A:A").ColumnWidth = 8
Range("B:B").ColumnWidth = 11
Range("C:C").ColumnWidth = 11
Range("D:D").ColumnWidth = 11
Range("E:E").ColumnWidth = 16
Range("F:F").ColumnWidth = 11
Range("G:G").ColumnWidth = 33
Range("H:H").ColumnWidth = 12
Range("I:I").ColumnWidth = 25
Range("J:J").ColumnWidth = 8
Range("K:K").ColumnWidth = 34
Range("L:L").ColumnWidth = 13
Range("M:M").ColumnWidth = 11
Range("N:N").ColumnWidth = 7
Range("O:O").ColumnWidth = 12
Range("P:P").ColumnWidth = 12
Range("Q:Q").ColumnWidth = 12
Range("R:R").ColumnWidth = 12
 
Next n
 
 
 
 '---Colonne A---CODE----
 'Format "General" la colonne A
 .Range("A2:A" & .Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = _
     "General"
 
 '---Colonne B---DATE---
 'Choix du format des dates
 .Range("B2:B" & .Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = _
     "dd/mm/yyyy"
 
 '---Colonne C---ANNEE---
 'Format "General" la colonne c
 .Range("C2:C" & .Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = _
     "General"
 
 
 
'---Toute La PLAGE DE DONNEES----
 Range("a1").CurrentRegion.Select
 Selection.Borders(xlDiagonalDown).LineStyle = xlNone
 Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline:   End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline:   End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline:   End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline:   End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline:   End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline:   End With
 
'Renvoie sur la Feuille de Synthése
Sheets("SYNTHESE").Activate
 
'Défige l'écran aprés l'éxécution de la macro
 Application.ScreenUpdating = True
 
 
 
End With
 
   On Error GoTo 0
   Exit Sub
 
formats_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & _
    ") in procedure formats of Module Formats" 'OK  ---- Message d'erreur
 
End Sub

**Daniel.C** · 07/11/2015, 12h22

Bonjour,

Essaie :

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
Sub Formats()
 
'Formatage des données
 
'Fige l'écran pendant l'éxécution de la macro
Application.ScreenUpdating = False
 
'Envoie sur la page des données
Sheets("COMPTES").Activate
 
 
 Dim n   'OK  ---- Déclare la variable n pour dénombrer les colonnes choisies dans la procédure de formatage de dates
On Error GoTo formats_Error 'OK  ---- Si erreur goto message erreur
 
With Sheets("COMPTES")
 
'Format century Gothic sur toute la BDD
With .Range("A2:R" & .Range("A" & Rows.Count).End(xlUp).Row).Font
    .Name = "Century Gothic"
    'Taille Caractére 8 sur toute la BDD
    .Size = 8
End With
 
 
'Alignement Gauche de certaines colonnes
'For Each n In Array(4, 5, 6, 7, 8, 9, 11, 12)
'.Columns(n).HorizontalAlignment = xlLeft
'Next n
.Range("D:I,K:L").HorizontalAlignment = xlCenter
'Alignement Centre de certaines colonnes
'For Each n In Array(1, 2, 3, 10, 13, 14)
'.Columns(n).HorizontalAlignment = xlCenter
'Next n
.Range("A:C,J:J,M:N").HorizontalAlignment = xlCenter
 
'Alignement Centre de certaines colonnes
'For Each n In Array(1, 2, 3, 10, 13, 14)
'.Columns(n).HorizontalAlignment = xlCenter
'Next n
 
''Format € de certaines colonnes
'For Each n In Array(15, 16, 17, 18)
'.Columns(n).NumberFormat = "#,##0.00 €"
'Next n
.Range("O:R").EntireColumn.NumberFormat = "#,##0.00 €"
 
'Alignement Droite de certaines colonnes
'For Each n In Array(15, 16, 17, 18)
'.Columns(n).HorizontalAlignment = xlRight
'Next n
.Range("O:R").EntireColumn.HorizontalAlignment = xlRight
 
'Format des titres de colonnes
With .Range("A1:R1")
    .Font.Name = "Century Gothic"
    .Font.Size = 10
    .Interior.ColorIndex = 43
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .NumberFormat = "General"
End With
 
 
'Ajustement automatique des colonnes
'For Each n In Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, _
'    18)
'.Columns(n).Columns.AutoFit
.Range("A:A,J:J").ColumnWidth = 8
.Range("B:D,F:F,M:M").ColumnWidth = 11
.Range("E:E").ColumnWidth = 16
.Range("G:G").ColumnWidth = 33
.Range("H:H,O:R").ColumnWidth = 12
.Range("I:I").ColumnWidth = 25
.Range("K:K").ColumnWidth = 34
.Range("L:L").ColumnWidth = 13
.Range("N:N").ColumnWidth = 7
 
'Next n
 
 
 
 '---Colonne A:C---CODE----
 'Format "General" la colonne A
 .Range("A2:C" & .Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = _
     "General"
 
 '---Colonne B---DATE---
 'Choix du format des dates
 .Range("B2:B" & .Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = _
     "dd/mm/yyyy"
 
 '---Colonne C---ANNEE---
 'Format "General" la colonne c
' .Range("C2:C" & .Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = _
'     "General"
 
 
 
'---Toute La PLAGE DE DONNEES----
 With .Range("a1").CurrentRegion
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline:   End With
    With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline:   End With
    With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline:   End With
    With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline:   End With
    With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline:   End With
    With .Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlHairline:   End With
End With
 
'Renvoie sur la Feuille de Synthése
Sheets("SYNTHESE").Activate
 
'Défige l'écran aprés l'éxécution de la macro
 Application.ScreenUpdating = True
 
 
 
End With
 
   On Error GoTo 0
   Exit Sub
 
formats_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & _
    ") in procedure formats of Module Formats" 'OK  ---- Message d'erreur
 
End Sub

**GADENSEB** · 07/11/2015, 17h41

Hello

Un grand merci à toi !

Parfait et rapide, comme toujours.

a+ seb

**patricktoulon** · 07/11/2015, 21h16

bonjour

on peut simplifier pour les bordures

Code :

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

1
2
3
4
5
6
With .Range("A1").CurrentRegion
.Borders(1).LineStyle = 1 'bordure gauche et insidevertical
.Borders(2).LineStyle = 1 'bordure droite et insidevertical
.Borders(3).LineStyle = 1 'bordure  top et 'insidehorizontal
.Borders(4).LineStyle = 1 'bordure bottom et insidehorizontal
End With

je vais peut etre expliquer autrement car mes commentaires peuvent induire en erreur de compréhention

borders(xledgeleft)=bordure left de la plage
borders(1)=bordures left de toutes les cellules de la plage ou d'une celle si il y a qu'une seule cellule dans la plage en reference

et pareil pour les autres

**GADENSEB** · 07/11/2015, 21h43

Excellent Patrick !!!

Code au top !

Merci !

bonne soirée

Fomat de cellules / Accélération du code [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager