Impossible de sélectionner des cellules après le lancement d'une macro

**BOUJ08** · 24/03/2016, 15h09

Bonjour le forum,

Jusqu'à ce matin j'avais 2 macros qui fonctionnaient très bien.
Après quelques manipulations pour essayer de comprendre le fonctionnement des modules de classe, je me retrouve maintenant face à un problème: après avoir lancé une des macros, je ne peux plus sélectionner de cellules sur ma feuille excel et je n'arrive pas à ouvrir d'autres fichiers excel! Quelqu'aurait-il une idée du pourquoi?

Merci

**casefayere** · 24/03/2016, 15h13

Bonjour,
et si tu donnais ta macro car je pense que tu peux encore atteindre l'éditeur

**BOUJ08** · 24/03/2016, 16h05

Bonjour,
Merci pour ta réponse rapide.
voilà la macro qui me pose problème. elle se trouve dans un module standard et j'ai effacé les modules de classe que j'avais créé pour tester ainsi que les lignes de codes que j'avais rajouté dans cette macro. Malgré cela le problème persiste.

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
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
Sub Macro1()
'
'
Dim TABLEAU As ListObject
Dim DERNIERE_FEUILLE As Worksheet, AVANT_DERNIERE_FEUILLE As Worksheet
Dim CELLULE_CALCULEE As Range, ETIQ_TOTAL As Range, ETIQ_TOP10 As Range, ETIQ_PART As Range, ETIQ_NbCODE As Range, TITRE As Range, Tx_Evol As Range
Dim LigneSource As Long, LigneDest As Long
Dim CACHE As PivotCache
Dim TCD1 As PivotTable, TCD2 As PivotTable
Dim Graph1 As Shape
 
 
Set DERNIERE_FEUILLE = Worksheets(Worksheets.Count)
Set AVANT_DERNIERE_FEUILLE = Worksheets(Worksheets.Count - 1)
 
 
'Ajout du nom des colonnes
Range("U1") = "Cause"
Range("V1") = "Sous Cause"
Range("W1") = "Leviers correctifs"
Range("X1") = "Evol Stock CRI vs M-1"
Range("y1") = "Provision"
Range("z1") = "Commentaires"
 
 
'définition du tableau de données
Set TABLEAU = DERNIERE_FEUILLE.ListObjects.Add(xlSrcRange, Range("A1").CurrentRegion, , xlYes)
TABLEAU.Name = "Stock8mois" & DERNIERE_FEUILLE.Name
 
With TABLEAU
    .ShowTableStyleRowStripes = False
    .ShowTableStyleColumnStripes = True
    .HeaderRowRange.Font.Color = 16777215
    .HeaderRowRange.Font.Bold = True
    .HeaderRowRange.Interior.Color = 16711680
    .HeaderRowRange.HorizontalAlignment = xlCenter
End With
 
 
 
 
With DERNIERE_FEUILLE 'sélectionne la dernière feuille du classeur
 
'Mise en place liste déroulante colonne CAUSE
For i = Cells(2, 21).CurrentRegion.Rows.Count To 2 Step -1 'pour toutes les cellules de la colonne U à partir de la ligne 2
    With Cells(i, 21).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="Industrie,Cial,Données techniques,Marketing / Stratégie,Réglementaire"
    End With
Next
 
'Mise en place liste déroulante colonne SOUS CAUSE
For i = Cells(2, 22).CurrentRegion.Rows.Count To 2 Step -1 'pour toutes les cellules de la colonne V à partir de la ligne 2
    With Cells(i, 22).Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="Prév > Sorties,Annulation tardive du besoin,Stock Sécu Client,Taille de lot,Anticipation,Retards,Qualité,Autres"
    End With
Next
 
'Mise en place liste déroulante LEVIERS CORRECTIFS
For i = Cells(2, 23).CurrentRegion.Rows.Count To 2 Step -1 'pour toutes les cellules de la colonne W à partir de la ligne 2
    With Cells(i, 23).Validation 'ajoute la liste déroulante des leviers correctifs
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="Déconditionner / Reconditionner,Détruire,Garder pour future prev"
    End With
Next
 
'Calcul et mise en forme colonne EVOL STOCKS CRI VS M-1
    'Calcul
LigneSource = AVANT_DERNIERE_FEUILLE.Cells(Rows.Count, "A").End(xlUp).Row
LigneDest = DERNIERE_FEUILLE.Cells(Rows.Count, "A").End(xlUp).Row
DERNIERE_FEUILLE.Range("X2:X" & LigneDest).Formula = "=T2-vlookup(H2,'" & AVANT_DERNIERE_FEUILLE.Name & "'!$H$1:$T$" & LigneSource & ",13,FALSE)" 'formule de calcul
 
Set CELLULE_CALCULEE = Range("X2", Range("X2").End(xlDown))
 
    'Mise en forme
On Error Resume Next
 
        'Icone de mise en forme
With CELLULE_CALCULEE.FormatConditions.AddIconSetCondition
        .ReverseOrder = True
        .ShowIconOnly = False
        .IconSet = ActiveWorkbook.IconSets(xl3Symbols)
End With
With CELLULE_CALCULEE.FormatConditions(1).IconCriteria(2)
        .Type = xlConditionValueNumber
        .Value = 0
        .Operator = 7
End With
With CELLULE_CALCULEE.FormatConditions(1).IconCriteria(3)
        .Type = xlConditionValueNumber
        .Value = 0
        .Operator = 5
End With
 
        'Remplacer #N/A et couleur de fond
For Each Cell In CELLULE_CALCULEE
 
            'Remplacer #N/A par nouveau
    If IsError(Cell.Value) Then Cell.Value = "Nouveau"
            On Error Resume Next 'pour les 4 procédures qui suivent si erreur passer à la ligne suivante
            'couleur de fond différente suivant la valeur de la cellule
    If Cell.Value = 0 Then Cell.Interior.Color = 6750207
    If Cell.Value > 0 Then Cell.Interior.Color = 7567101
    If Cell.Value < 0 Then Cell.Interior.Color = 10092492
    If Cell.Value = "Nouveau" Then Cell.Interior.Color = 16777215
Next
 
 
 
'Calcul total Stock > 8 mois
Set ETIQ_TOTAL = Range("S1").End(xlDown).Offset(6, 0)
With ETIQ_TOTAL
    .Value = "Total Stock > 8 mois en k€"
    .Font.Bold = True
    .HorizontalAlignment = xlCenter
End With
ETIQ_TOTAL.Offset(1, 0).Formula = "=sum(T2:T" & Range("T2").End(xlDown).Row & ")"
 
'Calcul Total Top 10
Set ETIQ_TOP10 = ETIQ_TOTAL.Offset(0, 2)
With ETIQ_TOP10
    .Value = "Total Top 10 en k€"
    .Font.Bold = True
    .HorizontalAlignment = xlCenter
End With
ETIQ_TOP10.Offset(1, 0).Formula = "=sum(T2:T11)"
 
'Calcul part du top 10 au total
Set ETIQ_PART = ETIQ_TOTAL.Offset(0, 4)
With ETIQ_PART
    .Value = "Part du Top 10"
    .Font.Bold = True
    .HorizontalAlignment = xlCenter
End With
ETIQ_PART.Offset(1, 0).Formula = "=RC[-2]/RC[-4]"
ETIQ_PART.Offset(1, 0).NumberFormat = "0%"
 
'Nombre de codes concernés
Set ETIQ_NbCODE = ETIQ_PART.Offset(0, 2)
With ETIQ_NbCODE
    .Value = "Nb de codes"
    .Font.Bold = True
    .HorizontalAlignment = xlCenter
End With
ETIQ_NbCODE.Offset(1, 0).Formula = "=counta(A2:A" & Range("A2").End(xlDown).Row & ")"
 
 
'Calcul des taux d'évolution vs M-1
Set Tx_Evol = Range("I1").End(xlDown).Offset(8, 0)
Tx_Evol.Value = "Evol vs M-1"
 
    'Tx Evol du total
ETIQ_TOTAL.Offset(2, 0).Formula = "=(S" & LigneDest + 7 & "-'" & AVANT_DERNIERE_FEUILLE.Name & "'!S" & LigneSource + 7 & ")/'" & AVANT_DERNIERE_FEUILLE.Name & "'!S" & LigneSource + 7 & ""
ETIQ_TOTAL.Offset(2, 0).NumberFormat = "0%"
If ETIQ_TOTAL.Offset(2, 0).Value > 0 Then
    ETIQ_TOTAL.Offset(2, 0).Font.Color = -16776961
Else
    ETIQ_TOTAL.Offset(2, 0).Font.Color = -11489280
End If
 
    'Tx Evol du Top 10
ETIQ_TOP10.Offset(2, 0).Formula = "=(U" & LigneDest + 7 & "-'" & AVANT_DERNIERE_FEUILLE.Name & "'!U" & LigneSource + 7 & ")/'" & AVANT_DERNIERE_FEUILLE.Name & "'!U" & LigneSource + 7 & ""
ETIQ_TOP10.Offset(2, 0).NumberFormat = "0%"
 
    'Tx Evol de la part du Top 10
ETIQ_PART.Offset(2, 0).Formula = "=(W" & LigneDest + 7 & "-'" & AVANT_DERNIERE_FEUILLE.Name & "'!W" & LigneSource + 7 & ")/'" & AVANT_DERNIERE_FEUILLE.Name & "'!W" & LigneSource + 7 & ""
ETIQ_PART.Offset(2, 0).NumberFormat = "0%"
 
    'Tx Evol du Nb de Code
ETIQ_NbCODE.Offset(2, 0).Formula = "=(Y" & LigneDest + 7 & "-'" & AVANT_DERNIERE_FEUILLE.Name & "'!Y" & LigneSource + 7 & ")/'" & AVANT_DERNIERE_FEUILLE.Name & "'!Y" & LigneSource + 7 & ""
ETIQ_NbCODE.Offset(2, 0).NumberFormat = "0%"
 
'Mise en forme titre
Set TITRE = Range(ETIQ_TOTAL.Offset(-2, 0), ETIQ_PART.Offset(-2, 0))
With TITRE
    .Merge
    .Value = "RECAPITULATIF STOCK > 8 MOIS " & DERNIERE_FEUILLE.Name
    .Font.Bold = True
    .Font.Size = 12
    .HorizontalAlignment = xlCenter
    .Borders(xlEdgeBottom).LineStyle = xlDash
End With
 
'TCD pour graphique
Set CACHE = ActiveWorkbook.PivotCaches.Create(xlDatabase, TABLEAU)
Set TCD1 = CACHE.CreatePivotTable(ETIQ_TOTAL.Offset(5, 0))
With TCD1
    .PivotFields("Marque").Orientation = xlRowField
    .PivotFields("Marque").Position = 1
    .PivotFields("Gamme khéops").Orientation = xlRowField
    .AddDataField .PivotFields("Stock dans 8M hors entrée K€"), "Répartition par gamme", xlSum
End With
 
 
Set Graph1 = DERNIERE_FEUILLE.Shapes.AddChart2(251, xlPie)
With Graph1
    With .Chart
        .SetSourceData Source:=ETIQ_TOTAL.Offset(5, 0).End(xlToRight).End(xlDown)
        .HasTitle = False
        .SetElement (msoElementDataLabelBestFit)
        .Legend.Position = xlLegendPositionCorner
        .FullSeriesCollection(1).DataLabels.ShowValue = False
        .FullSeriesCollection(1).DataLabels.ShowPercentage = True
    End With
    .Top = ETIQ_TOTAL.Offset(5, 0).End(xlDown).Offset(1, 0).Top
    .Left = ETIQ_TOTAL.Offset(5, 0).End(xlDown).Offset(1, 0).Left
    .Width = Range(ETIQ_TOTAL.Offset(5, 0), ETIQ_TOTAL.Offset(5, 0).End(xlToRight)).Width
End With
 
Set TCD2 = CACHE.CreatePivotTable(ETIQ_PART.Offset(5, 0))
With TCD2
    .PivotFields("Marque").Orientation = xlRowField
    .PivotFields("Marque").Position = 1
    .PivotFields("Gamme khéops").Orientation = xlRowField
    .PivotFields("Cause").Orientation = xlColumnField
    .AddDataField .PivotFields("Stock dans 8M hors entrée K€"), "Répartition gamme/cause", xlSum
End With
 
 
'Masquer colonne
Columns("A:G").EntireColumn.Hidden = True
Columns("J:R").EntireColumn.Hidden = True
 
'Fractionner écran après Top 10
With ActiveWindow
        .SplitRow = 11
        .ScrollColumn = 8
        .DisplayGridlines = False
End With
 
With ActiveWindow.Panes(3)
    .Activate
    .Application.Goto reference:=Range("H1").End(xlDown).Offset(2, 0), scroll:=True
End With
 
End With
 
End Sub

**casefayere** · 24/03/2016, 16h17

un code edité comme ça est indigeste, penses à le mettre entre balises en cliquant sur "#".
en attendant, si tu executes celui=ci avec des points d'arrêt, tu verras à quelle ligne se produit l'erreur, exemple :
1er point d'arrêt sur cette ligne

Code :

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

Range("U1") = "Cause"

2eme sur celle=ci

Code :

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

Set TABLEAU = DERNIERE_FEUILLE.ListObjects.Add(xlSrcRange, Range("A1").CurrentRegion, , xlYes)

3eme sur la suivante,
etc.

**BOUJ08** · 24/03/2016, 16h18

J'ai rajouté Application.EnableEvents = false au début de la macro ci-dessus, et du coup ça fonctionne. Mais je comprend pas pourquoi sachant que j'ai supprimer tous les modules de classes liés aux événements ! quelqu'un le sait-il?

**BOUJ08** · 24/03/2016, 16h24

Envoyé par casefayere

un code edité comme ça est indigeste, penses à le mettre entre balises en cliquant sur "#".
en attendant, si tu executes celui=ci avec des points d'arrêt, tu verras à quelle ligne se produit l'erreur, exemple :
1er point d'arrêt sur cette ligne

Code :

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

Range("U1") = "Cause"

2eme sur celle=ci

Code :

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

Set TABLEAU = DERNIERE_FEUILLE.ListObjects.Add(xlSrcRange, Range("A1").CurrentRegion, , xlYes)

3eme sur la suivante,
etc.

c'est vrai et j'en suis désolé, et je te remercie de te pencher sur mon problème. En rajoutant application.enableevents=false au début la macro fonctionne à nouveau mais je ne comprend pas pour quoi je dois le spécifier puisque j'ai effacé tous les modules de classes et lignes de codes liées à des évènements! tu as une idée peut être?

merci encore

**casefayere** · 24/03/2016, 16h27

tu as une idée peut être?

pas dans l'immédiat, si j'arrive à décortiquer ton code et si je vois une ligne qui me chagrine, je le dirai

Invité · 24/03/2016, 20h37

Bonsoir,
Tu mets un on error resume Next mais je ne vois pas de on error Goto 0 et encore moins l'endroit ou tu gère l'erreur!

Enlève ce vilain on error et là on commencera à y voir mieux!

Note également qu'on va pas analyser les 2000 lignes de ton code, penses a réduire amplitude des recherches quand tu auras viré le on errer!

Impossible de sélectionner des cellules après le lancement d'une macro

Macros et VBA Excel

Discussions similaires

Partager

Partager