Accélérer l'éxécution d'un code

**Domimart** · 11/01/2010, 10h25

Bonjour,

Je cherche a accélérer l'éxécution du code d'une macro, sur un PC rapide cela va encore, mais au boulot ça rame pas mal.
Le code source fonctionne mais dès que j'essaye de compiler cela me génère des erreurs; voici le code source :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
     Sheets("Di imp").Select
    Call Macro_effac_sem                   '  effacer et re mise en forme des feuilles
    Sheets("Lun imp").Select
    Call Macro_effac_sem
    Sheets("Mar imp").Select
    Call Macro_effac_sem
    Sheets("Mer imp").Select
    Call Macro_effac_sem
    Sheets("Jeu imp").Select
    Call Macro_effac_sem
    Sheets("Ven imp").Select
    Call Macro_effac_sem
    Sheets("Sam imp").Select
    Call Macro_effac_sem

voici un des codes que j'ai essayé

Code :

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

1
2
3
4
5
6
7
8
9
  If confirmation = vbYes Then
    'Call ControleMotDePasse("prod3", 2)
    Application.ScreenUpdating = False
 
  Dim strFeuille As String
  strFeuille = ActiveSheet.Name
 
  Union(Sheets("Di imp,Lun imp,Mar imp,Mer imp,Jeu imp,Ven imp,Sam imp")).Select
  Call Macro_effac_sem                   '  effacer et remise en forme des feuilles

ce qui me génère : erreur de compilation : argument non facultatif
Merci de votre aide

Dom

**mercatog** · 11/01/2010, 11h20

Bonjour,
si tu mettais le code de la procédure Macro_effac_sem

en générl le Select inutile augmente le temps d'exécution

**Domimart** · 11/01/2010, 11h33

Bonjour Mercatog

La macro efface semaine me sert alternativement a effacer tous les jours de la semaine paire ( Di pair à Sam Pair) et alternativement tous les jours de la semaine impaire(Di imp à Sam imp); Elle sert également a refaire toute la mise en forme des feuilles de saisie car les différents opérateurs ont des codes de couleur, alors le code est long et fastidieux. Toutes les feuilles ont la même mise en forme
le voici :

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
 Sub Macro_effac_sem()
'
' Macro_effac_sem_complèteMacro
' Macro enregistrée le 05/03/2008 par Dominique
'
 
    Application.ScreenUpdating = False
 
     Union(Range( _
        "L48,F4,H7,c11:f15,d16:e17,b17:c17,b11,b13,b15,f17,h11:l12,j13:k17,h16:i17,h14:i14,l13:l14,l16:l17,d19:e37,b39:f49,j19:k46,j47:j48,b24:c24,b26:c26,h20:i20,h49:l49" _
        ), Range( _
        "L99,F55,H58,C62:F66,D67:E68,B68:C68,B62,B64,B66,F68,H62:L63,J64:K68,H67:I68,H65:I65,L64:L65,L67:L68,D70:E88,B90:F100,J70:K97,J98:J99,H100:L100,B71:C71,B73:C73,B75:C75,B77:C77,H71:J71" _
        ), Range( _
        "L150,F106,H109,C113:F117,D118:E119,B119:C119,B113,B115,B117,F119,H113:L114,J115:K119,H118:I119,H116:I116,L115:L116,L118:L119,D121:E139,B141:F151,J121:K148,J149:J150,H151:L151,B122:C122,B124:C124,B126:C126,B128:C128,H122:i122" _
        ), Range( _
        "F157,H160,C164:F168,D169:E170,B170:C170,B164,B166,B168,F170,H164:L165,J166:K170,H169:I170,H167:I167,L166:L167,L169:L170,D172:E190,B192:F202,J172:K199,H200:L202,B173:C173,B175:C175,B177:C177,B179:C179,H173:I173,B215:F224,H215:L224" _
        )).Select
    Selection.ClearContents
    Selection.Interior.ColorIndex = xlNone
    Range( _
        "E23,B11:F17,H11:L17,B19:F37,H19:L49,B39:F49,B62:F68,H62:L68,B70:F88,H70:L100,B90:F100,B113:F119,H113:L119,H121:L151,B121:F139,B141:F151,B164:F170,H164:L170,B172:F190,H172:L202,B192:F202" _
        ).Select
 
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Range("B154:L203,B103:L152,B52:L101,B1:L50").Select
 
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
 
         Range("B38,B89,B140,D18:E18,J18:K18,D69,J69,D120,J120,D171,J171").Select
 
    With Selection.Interior
        .ColorIndex = 0
        .Pattern = xlGray25
        .PatternColorIndex = xlAutomatic
    End With
 
    Range("H7").Select
End Sub

**mercatog** · 11/01/2010, 11h48

Re,
déjà tu peux virer toutes tes Select
par exemple au lieu de

Code :

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

1
2
Range("A1").select
selection.clearcontents

tu fais

Code :

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

Range("A1").clearcontents

En plus, tu n'as pas besoin de toutes les lignes de code pour faire ta mise en page: par exemple

Code :

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

        .ColorIndex = xlAutomatic

**Domimart** · 11/01/2010, 12h06

C'est une macro que j'ai enregisté via l'enregistreur de macro. En fait j'aimerais savoir si au lieu de sélectionner les feuilles une par une et lancer efface_sem à chaque fois, je pouvais faire une sélection de groupe avant de lancer Efface_sem

**mercatog** · 11/01/2010, 12h11

Re,
Commence d'abord par éliminer toutes les Select de Sub Macro_effac_sem() (cf. mon dernier post)
Elles ne font que retarder!
L'enregistreur de macro utile, mais en rajoute énormément

On peut après entrer le nom de la feuille comme paramètre de la sub

**martinmacfly** · 11/01/2010, 12h21

En plus de supprimer les Select (ça me semble être la priorité), il y a pas mal de lignes de mise en forme que tu dois pouvoir enlever aussi, et simplifier de toute façon. Par exemple :

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
Range( _
        "E23,B11:F17,H11:L17,B19:F37,H19:L49,B39:F49,B62:F68,H62:L68,B70:F88,H70:L100,B90:F100,B113:F119,H113:L119,H121:L151,B121:F139,B141:F151,B164:F170,H164:L170,B172:F190,H172:L202,B192:F202" _
        ).Select
 
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With

Première simplification qui rendra déjà le truc plus lisible :

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
With Range( _
        "E23,B11:F17,H11:L17,B19:F37,H19:L49,B39:F49,B62:F68,H62:L68,B70:F88,H70:L100,B90:F100,B113:F119,H113:L119,H121:L151,B121:F139,B141:F151,B164:F170,H164:L170,B172:F190,H172:L202,B192:F202" _
        )
 
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
    .Borders(xlDiagonalDown).LineStyle = xlNone
    .Borders(xlDiagonalUp).LineStyle = xlNone
    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
End With

Mais surtout, tout ça est un peu long pour dire "Je ne veux pas de traits dans ma cellule" (tous les xlNone), surtout que tu n'en fais probablement jamais... A mon avis, tu n'as pas du tout besoin de tout ça, et si tu écrivais juste ça :

Code :

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

1
2
3
4
5
6
7
With Range( _
        "E23,B11:F17,H11:L17,B19:F37,H19:L49,B39:F49,B62:F68,H62:L68,B70:F88,H70:L100,B90:F100,B113:F119,H113:L119,H121:L151,B121:F139,B141:F151,B164:F170,H164:L170,B172:F190,H172:L202,B192:F202" _
        ).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With

... ça te suffirait largement !

EDIT : Et même ici, je pense que le ColorIndex et le LineStyle sont inutiles, si tu veux seulement faire une bordure, il te suffit de ça !

Code :

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

1
2
3
Range( _
        "E23,B11:F17,H11:L17,B19:F37,H19:L49,B39:F49,B62:F68,H62:L68,B70:F88,H70:L100,B90:F100,B113:F119,H113:L119,H121:L151,B121:F139,B141:F151,B164:F170,H164:L170,B172:F190,H172:L202,B192:F202" _
        ).Borders(xlEdgeLeft).Weight = xlThin

**Domimart** · 11/01/2010, 12h33

Mercatog,
voici ce que ça donne pour le début après je ne comprends plus très bien,

Sub Macro_effac_sem_TEST()

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
 
'
' Macro_effac_sem_complèteMacro
' Macro enregistrée le 05/03/2008 par Dominique
'
 
    Application.ScreenUpdating = False
 
     Union(Range( _
        "L48,F4,H7,c11:f15,d16:e17,b17:c17,b11,b13,b15,f17,h11:l12,j13:k17,h16:i17,h14:i14,l13:l14,l16:l17,d19:e37,b39:f49,j19:k46,j47:j48,b24:c24,b26:c26,h20:i20,h49:l49" _
        ), Range( _
        "L99,F55,H58,C62:F66,D67:E68,B68:C68,B62,B64,B66,F68,H62:L63,J64:K68,H67:I68,H65:I65,L64:L65,L67:L68,D70:E88,B90:F100,J70:K97,J98:J99,H100:L100,B71:C71,B73:C73,B75:C75,B77:C77,H71:J71" _
        ), Range( _
        "L150,F106,H109,C113:F117,D118:E119,B119:C119,B113,B115,B117,F119,H113:L114,J115:K119,H118:I119,H116:I116,L115:L116,L118:L119,D121:E139,B141:F151,J121:K148,J149:J150,H151:L151,B122:C122,B124:C124,B126:C126,B128:C128,H122:i122" _
        ), Range( _
        "F157,H160,C164:F168,D169:E170,B170:C170,B164,B166,B168,F170,H164:L165,J166:K170,H169:I170,H167:I167,L166:L167,L169:L170,D172:E190,B192:F202,J172:K199,H200:L202,B173:C173,B175:C175,B177:C177,B179:C179,H173:I173,B215:F224,H215:L224" _
        )).ClearContents
 
 Range ( _
        "E23,B11:F17,H11:L17,B19:F37,H19:L49,B39:F49,B62:F68,H62:L68,B70:F88,H70:L100,B90:F100,B113:F119,H113:L119,H121:L151,B121:F139,B141:F151,B164:F170,H164:L170,B172:F190,H172:L202,B192:F202" _
        )
 
             .Borders(xlDiagonalDown).LineStyle = xlNone
             .Borders(xlDiagonalUp).LineStyle = xlNone
             .Borders(xlEdgeLeft).LineStyle = xlNone
             .Borders(xlEdgeTop).LineStyle = xlNone
             .Borders(xlEdgeBottom).LineStyle = xlNone
             .Borders(xlEdgeRight).LineStyle = xlNone
             .Borders(xlInsideVertical).LineStyle = xlNone
             .Borders(xlInsideHorizontal).LineStyle = xlNone
             .Borders(xlDiagonalDown).LineStyle = xlNone
             .Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Range("B154:L203,B103:L152,B52:L101,B1:L50").Select
 
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
 
         Range ("B38,B89,B140,D18:E18,J18:K18,D69,J69,D120,J120,D171,J171")
 
        .ColorIndex = 0
        .Pattern = xlGray25
        .PatternColorIndex = xlAutomatic
 
 
    Range("H7").Select
End Sub

Cordialement
Dom

**mercatog** · 11/01/2010, 12h42

Le clearcontents ok
ensuite, Non, au lieu de

Code :

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

1
2
3
Range(X). select
selection.action1
selection.action2

Code :

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

1
2
3
4
With Range(X)
  .action1
  .action2
End with

ce que donne:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 With Range("E23,B11:F17,H11:L17,B19:F37,H19:L49,B39:F49,B62:F68,H62:L68,B70:F88,H70:L100,B90:F100,B113:F119,H113:L119,H121:L151,B121:F139,B141:F151,B164:F170,H164:L170,B172:F190,H172:L202,B192:F202")
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlInsideVertical).LineStyle = xlNone
    .Borders(xlInsideHorizontal).LineStyle = xlNone
    .Borders(xlEdgeLeft) = xlThin
    .Borders(xlEdgeTop) = xlThin
 
'la suite
End With

**Domimart** · 11/01/2010, 14h40

Re bonjour
ouh la tu vas un peu vite pour moi!

donc après divers essais voici ce que ça donne:

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
Sub Macro_effac_sem_TEST()
'
' Macro_effac_sem_complèteMacro
' Macro enregistrée le 05/03/2008 par Dominique
'
    Application.ScreenUpdating = False
 
     Union(Range( _
        "L48,F4,H7,c11:f15,d16:e17,b17:c17,b11,b13,b15,f17,h11:l12,j13:k17,h16:i17,h14:i14,l13:l14,l16:l17,d19:e37,b39:f49,j19:k46,j47:j48,b24:c24,b26:c26,h20:i20,h49:l49" _
        ), Range( _
        "L99,F55,H58,C62:F66,D67:E68,B68:C68,B62,B64,B66,F68,H62:L63,J64:K68,H67:I68,H65:I65,L64:L65,L67:L68,D70:E88,B90:F100,J70:K97,J98:J99,H100:L100,B71:C71,B73:C73,B75:C75,B77:C77,H71:J71" _
        ), Range( _
        "L150,F106,H109,C113:F117,D118:E119,B119:C119,B113,B115,B117,F119,H113:L114,J115:K119,H118:I119,H116:I116,L115:L116,L118:L119,D121:E139,B141:F151,J121:K148,J149:J150,H151:L151,B122:C122,B124:C124,B126:C126,B128:C128,H122:i122" _
        ), Range( _
        "F157,H160,C164:F168,D169:E170,B170:C170,B164,B166,B168,F170,H164:L165,J166:K170,H169:I170,H167:I167,L166:L167,L169:L170,D172:E190,B192:F202,J172:K199,H200:L202,B173:C173,B175:C175,B177:C177,B179:C179,H173:I173,B215:F224,H215:L224" _
        )).Select
    Selection.ClearContents
    Selection.Interior.ColorIndex = xlNone
 
With Range( _
        "E23,B11:F17,H11:L17,B19:F37,H19:L49,B39:F49,B62:F68,H62:L68,B70:F88,H70:L100,B90:F100,B113:F119,H113:L119,H121:L151,B121:F139,B141:F151,B164:F170,H164:L170,B172:F190,H172:L202,B192:F202" _
        ).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    Range("H7").Select
End Sub

mais pour le coup, je n'ai plus auccun contour de cellule dans le formulaire
cordialement
Dom

**mercatog** · 11/01/2010, 15h03

à mettre dans un module général

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
Option Explicit
 
Public Sub Macro_effac_sem(ByVal NomSheet As String)
 
Application.ScreenUpdating = False
With Sheets(NomSheet)
    With Union(.Range("L48,F4,H7,c11:f15,d16:e17,b17:c17,b11,b13,b15,f17,h11:l12,j13:k17,h16:i17,h14:i14,l13:l14,l16:l17,d19:e37,b39:f49,j19:k46,j47:j48,b24:c24,b26:c26,h20:i20,h49:l49"), .Range("L99,F55,H58,C62:F66,D67:E68,B68:C68,B62,B64,B66,F68,H62:L63,J64:K68,H67:I68,H65:I65,L64:L65,L67:L68,D70:E88,B90:F100,J70:K97,J98:J99,H100:L100,B71:C71,B73:C73,B75:C75,B77:C77,H71:J71"), .Range("L150,F106,H109,C113:F117,D118:E119,B119:C119,B113,B115,B117,F119,H113:L114,J115:K119,H118:I119,H116:I116,L115:L116,L118:L119,D121:E139,B141:F151,J121:K148,J149:J150,H151:L151,B122:C122,B124:C124,B126:C126,B128:C128,H122:i122"), .Range("F157,H160,C164:F168,D169:E170,B170:C170,B164,B166,B168,F170,H164:L165,J166:K170,H169:I170,H167:I167,L166:L167,L169:L170,D172:E190,B192:F202,J172:K199,H200:L202,B173:C173,B175:C175,B177:C177,B179:C179,H173:I173,B215:F224,H215:L224"))
        .ClearContents
        .Interior.ColorIndex = xlNone
    End With
 
    With .Range("E23,B11:F17,H11:L17,B19:F37,H19:L49,B39:F49,B62:F68,H62:L68,B70:F88,H70:L100,B90:F100,B113:F119,H113:L119,H121:L151,B121:F139,B141:F151,B164:F170,H164:L170,B172:F190,H172:L202,B192:F202")
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).Weight = xlMedium
        .Borders(xlEdgeTop).Weight = xlMedium
        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlEdgeRight).Weight = xlMedium
        .Borders(xlInsideVertical).Weight = xlThin
        .Borders(xlInsideHorizontal).Weight = xlThin
    End With
 
    With .Range("B154:L203,B103:L152,B52:L101,B1:L50")
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).Weight = xlMedium
        .Borders(xlEdgeTop).Weight = xlMedium
        .Borders(xlEdgeBottom).Weight = xlMedium
        .Borders(xlEdgeRight).Weight = xlMedium
        .Borders(xlInsideVertical).Weight = xlThin
        .Borders(xlInsideHorizontal).Weight = xlThin
    End With
 
    With .Range("B38,B89,B140,D18:E18,J18:K18,D69,J69,D120,J120,D171,J171")
        With .Interior
        .ColorIndex = 0
        .Pattern = xlGray25
        End With
    End With
 
    .Range("H7").Select
End With
Application.ScreenUpdating = True
End Sub

tu peux l'appeler par exemple comme ceci

Code :

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

1
2
3
4
5
6
7
8
9
10
Public Sub Imprim()
Dim strFeuille
Dim i As Byte
 
strFeuille = Array("Di imp", "Lun imp", "Mar imp", "Mer imp", "Jeu imp", "Ven imp", "Sam imp")
 
For i = 0 To UBound(strFeuille)
    Call Macro_effac_sem(strFeuille(i))
Next i
End Sub

**Domimart** · 12/01/2010, 13h28

Merci beaucoup Mercatog,
Cela fonctionne parfaitement et j'ai gagné du temps et surtout de la clarté dans le code.
De plus j'ai retiré le ScreenUpdating.True à la fin car l'écran sautillait entre chaque page.
Je ne sais pas si c'est une bonne idée, mais j'ai lu quelque part que le Screen updating se remettait automatiquement à True à la fin d'un code, du coups je ne mets jamais cette ligne de commande dans mes codes.

Je pensais bien gagner du temps en groupant les feuilles avant de lancer la cmd Efface_sem, mais je ne comprenais pas trop comment simplifier le code enregistrer via l'enregistreur de macro. Je m'occupe surtout de supprimer les mouvements d'écran et de grouper les sélections à chaque fois.

Encore merci pour ton aide et bon forum

Cordialement
Dom

Accélérer l'éxécution d'un code [XL-2007]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager