problème de macro qui repart au début

**Etudiante113475** · 17/03/2014, 14h42

Bonjour,
mon soucis est qu'il est impossible d'arrêter la macro à la fin, c'est à dire qu'elle reprend du début, et qu'elle bloque en voulant repartir.
Cela m'affiche le message suivant:

La méthode Move de la classe worksheet a échoué

Ma macro commence en effet par activesheet.move

J'ai effectué des recherches et je suis tombée sur ce code:

Code :

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

1
2
3
Application.EnableEvents=Falserange("A1")=
range("A1")+1
Application.EnableEvents=True

Je ne sais pas comment le mettre en place
Je vous remercie pour votre aide

**NicolasST** · 17/03/2014, 14h47

Peux-tu être plus précise.
Comment s'active ta macro?
Que fait-elle?

**Etudiante113475** · 17/03/2014, 14h57

Ma macro s'active suite à un double clic, elle sert ensuite à faire une mise en forme (coloriage de colonne, sous totaux...)

**NicolasST** · 17/03/2014, 15h22

Puex-tu copier ton code, STP?

**Etudiante113475** · 17/03/2014, 15h29

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
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
Private Sub libelle_Click()
 
End Sub
Private Sub UserForm_Activate()
    UF_000.Repaint
    UF_000.libelle.Caption = "DeList..."
    UF_000.Repaint
    DeList
    UF_000.libelle.Caption = "extraction feuille..."
    UF_000.Repaint
    extraction_feuille
    UF_000.libelle.Caption = "trier4..."
    UF_000.Repaint
    Trier4
    UF_000.libelle.Caption = "sous totaux3..."
    UF_000.Repaint
    Sous_totaux3
    UF_000.libelle.Caption = "Format monnaie..."
    UF_000.Repaint
    format_monnaie
    UF_000.libelle.Caption = "coloriage1..."
    UF_000.Repaint
    coloriage1
    UF_000.libelle.Caption = "coloriage2..."
    UF_000.Repaint
    coloriage2
    UF_000.libelle.Caption = "ajuster colonne..."
    UF_000.Repaint
    ajuster_colonne
    UF_000.libelle.Caption = "mise en forme titre..."
    UF_000.Repaint
    mise_en_forme_titre
    UF_000.libelle.Caption = "bordure1..."
    UF_000.Repaint
    bordure1
    UF_000.libelle.Caption = "bordure2..."
    UF_000.Repaint
    bordure2
    UF_000.libelle.Caption = "destruction colonne M..."
    UF_000.Repaint
    destruction_col_M
    UF_000.libelle.Caption = "colonne total..."
    UF_000.Repaint
    Colonne_total
    UF_000.libelle.Caption = "zoom 75..."
    UF_000.Repaint
    zoom75
    UF_000.Hide
    Unload UF_000
End Sub
Sub DeList()
 Dim Worksheet As Worksheet
 Dim objectListObject As ListObject
 
 Set Worksheet = ActiveWorkbook.ActiveSheet
 Set objectListObject = Worksheet.ListObjects(1)
 objectListObject.Unlist
 
extraction_feuille
 
End Sub
 
 
 
Sub extraction_feuille()
   ActiveSheet.Move
   ActiveSheet.Name = ("Feuil1")
 
Trier4
End Sub
Sub Trier4()
'
' Trier4 Macro
'
 
'
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range( _
        "G2:G177438"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range( _
        "I2:I177438"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range( _
        "A2:A177438"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("A1:O177438")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Sous_totaux3
End Sub
 
 
Sub Sous_totaux3()
'
' Sous_totaux3 Macro
'
 
'
    'ActiveSheet.PageSetup.PrintArea = Selection
    Range("A1").CurrentRegion.Select
 
    Selection.Subtotal GroupBy:=7, Function:=xlSum, TotalList:=Array(10, 11, 12 _
        , 13, 14), Replace:=False, PageBreaks:=False, SummaryBelowData:=True
 
    Range("A1").CurrentRegion.Select
    Selection.Subtotal GroupBy:=9, Function:=xlSum, TotalList:=Array(10, 11, 12 _
        , 13, 14), Replace:=False, PageBreaks:=False, SummaryBelowData:=True
 
 
format_monnaie
End Sub
Sub format_monnaie()
'
' format_monnaie Macro
'
 
'
    Range("J:K,M:N").Select
    Range("M1").Activate
    Selection.NumberFormat = _
        "_-* #,##0.00 [$€-40C]_-;-* #,##0.00 [$€-40C]_-;_-* ""-""?? [$€-40C]_-;_-@_-"
coloriage1
End Sub
 
 
 
Sub coloriage1()
 
    Dim c As Range
    Dim firstAddress As Variant
 
    With Range("I:I")
        Set c = .Find("Total")
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                c.Offset(0, -8).Resize(1, 15).Interior.ColorIndex = 42
                c.Offset(0, -8).Resize(1, 15).Font.Bold = True
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
coloriage2
End Sub
Sub coloriage2()
 
    Dim c As Range
    Dim firstAddress As Variant
 
    With Range("G:G")
        Set c = .Find("Total")
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                c.Offset(0, -6).Resize(1, 15).Interior.ColorIndex = 44
                c.Offset(0, -6).Resize(1, 15).Font.Bold = True
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    End With
ajuster_colonne
End Sub
Sub ajuster_colonne()
'
' ajuster_colonne Macro
'
 
'
    Range("A1").CurrentRegion.Select
    Selection.Columns.AutoFit
mise_en_forme_titre
End Sub
Sub mise_en_forme_titre()
'
' mise_en_forme_titre Macro
'
 
'
    Range("A1:O1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Bold = True
bordure1
End Sub
 
Sub bordure1()
'
' Bordure1 Macro
'
 
'
    Range("A1").CurrentRegion.Select
 
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0.499984740745262
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0.499984740745262
        .Weight = xlThin
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0.499984740745262
        .Weight = xlThin
    End With
bordure2
End Sub
Sub bordure2()
'
' bordure2 Macro
'
 
'
    Range(Cells(1, 1), Cells(1, 15)).Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0.499984740745262
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0.499984740745262
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0.499984740745262
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ThemeColor = 2
        .TintAndShade = 0.499984740745262
        .Weight = xlMedium
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
 
destruction_col_M
End Sub
Sub destruction_col_M()
    Columns("M:M").Delete Shift:=xlToLeft
 
Colonne_total
End Sub
Sub Colonne_total()
'
' Colonne_total Macro
'
 
'
    Columns("M:M").Select
    Selection.ColumnWidth = 18
    Columns("L:L").Select
    Selection.ColumnWidth = 4
 
zoom75
End Sub
 
Sub zoom75()
 
    ActiveWindow.Zoom = 75
 
End Sub

**NicolasST** · 17/03/2014, 16h10

Merci, tu dis que ta macro est executée lors d'un double-clic, tu dois alors avoir associé à ta feuille de calcul des macros evenementielles du type :

Code :

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

1
2
3
4
5
6
7
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 
End Sub
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
End Sub

Dans ces macros quelles sont les macros appelées?

problème de macro qui repart au début

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager