La méthode Intersect de _Application à échoué

**Sciön** · 22/05/2014, 11h05

Bonjour tout le monde ,

Je planche sur un problème depuis plus de deux jours, voila :

En gros j'ai une case "supprimer" qui supprime 3 cases ( remplacement vers le haut ) si on clique dessus, le seul problème c'est que une fois le code supprimmé , je bug est généré ....

et je ne vois vraiment pas de quoi cela pourrais provenir.

Je vous montre le code en question

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
 If Not Application.Intersect(Target, Range(Range("D7"), Range("D65000").End(xlUp))) Is Nothing Then
              If Cells(Target.Row, 3) <> "" Then
              If MsgBox("Etes-vous certain de vouloir supprimer ?", vbYesNo + vbQuestion) = vbYes Then
                    Dim maCel As Range
                    Set maCel = Target
                    maCel.Offset(0, -2).Delete Shift:=xlUp '==> ici on supprimme en décalant vers le haut ( parce que j'en ai besoin )
                    maCel.Offset(0, -1).Delete Shift:=xlUp
                    maCel.Delete Shift:=xlUp
 
               End If
 
                Range("B7:B100").Sort Key1:=Range("B7"), Order1:=xlAscending
          Range("C7:B100").Sort Key1:=Range("C7"), Order1:=xlAscending
          Range("D7:B100").Sort Key1:=Range("D7"), Order1:=xlAscending
 
               End If
          'Cells(ActiveCell.Offset(3, 1), 1).Clear
 
         Else
         If Not Application.Intersect(Target, Range(Range("C7"), Range("C65000").End(xlUp))) Is Nothing Then '=== sauf que du coup ça plante la
              If Cells(Target.Row, 3) <> "" Then                                                        '=> la méthode intersect de l'application a échoué <==
            Dim resultat As String

Voila, si quelqu'un voit de quoi il s'agit, il aura tout mon respect , moi j'ai limite envie de jeter l'éponge ...

**Marc-L** · 22/05/2014, 12h25

Bonjour,

désactiver les évènements en début de procédure (consulter l'aide de la propriété EnableEvents) pour voir …

Et ne pas oublier de les réactiver en fin de procédure !

**Sciön** · 22/05/2014, 15h10

J'ai tenté de plusieurs manières mais c'est pareil

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
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 
    Dim V1 As Integer
    Dim V2 As Integer
    Dim V3 As Integer
    Dim V4 As Integer
    Dim V5 As Integer
    Dim Increment As Integer
 
 
   If Not Application.Intersect(Target, Range("AjouterType")) Is Nothing Then
          Application.EnableEvents = False ' => désactive les événements
        Increment = 7
        Range("EditType").Copy
 
        While Not (Cells(Increment, 2) = "")
 
            Increment = Increment + 1
 
        Wend
 
        Cells(Increment, 2).PasteSpecial xlPasteAll
        Range("ModifierType").Copy
        Cells(Increment, 3).PasteSpecial xlPasteAll
        Range("SupprimerType").Copy
        Cells(Increment, 4).PasteSpecial xlPasteAll
        Range("B7:B100").Sort Key1:=Range("B7"), Order1:=xlAscending
        Range("C7:B100").Sort Key1:=Range("C7"), Order1:=xlAscending
        Range("D7:B100").Sort Key1:=Range("D7"), Order1:=xlAscending
 
    ElseIf Not Application.Intersect(Target, Range(Range("D7"), Range("D65000").End(xlUp))) Is Nothing Then
 
        If Cells(Target.Row, 3) <> "" Then
 
            If MsgBox("Etes-vous certain de vouloir supprimer ?", vbYesNo + vbQuestion) = vbYes Then
 
                Dim maCel As Range
                Set maCel = Target
 
                maCel.Offset(0, -2).Delete shift:=xlShiftUp '=== ici on supprimme en décalant vers le haut ( parce que j'en ai besoin )
                maCel.Offset(0, -1).Delete shift:=xlShiftUp
                maCel.Delete shift:=xlShiftUp
 
 
            End If
 
            Range("B7:B100").Sort Key1:=Range("B7"), Order1:=xlAscending
            Range("C7:B100").Sort Key1:=Range("C7"), Order1:=xlAscending
            Range("D7:B100").Sort Key1:=Range("D7"), Order1:=xlAscending
 
 
        End If
 
    ElseIf Not Application.Intersect(Target, Range(Range("C7"), Range("C65000").End(xlUp))) Is Nothing Then '=== sauf que du coup ça plante la
 
        If Cells(Target.Row, 3) <> "" Then                                                        '=> la méthode intersect de l'application a échoué <==
 
            Dim resultat As String
            resultat = InputBox("Modification ?", "Titre")
            Dim maCel2 As Range
            Set maCel2 = Target
 
            If resultat <> "" Then
 
                maCel2.Offset(0, -1) = resultat
                Range("B7:B10000").Sort Key1:=Range("B7"), Order1:=xlAscending
                Range("C7:B10000").Sort Key1:=Range("C7"), Order1:=xlAscending
                Range("D7:B10000").Sort Key1:=Range("D7"), Order1:=xlAscending
 
            End If
        End If
    End If
 
 
          If Not Application.Intersect(Target, Range("K3")) Is Nothing Then '=== ou la
          Increment = 7
             Range("J3").Copy
                While Not (Cells(Increment, 10) = "")
 
                      Increment = Increment + 1
 
                Wend
 
 
        Cells(Increment, 10).PasteSpecial xlPasteAll
        Range("ModifierType").Copy
        Cells(Increment, 11).PasteSpecial xlPasteAll
        Range("SupprimerType").Copy
         Cells(Increment, 12).PasteSpecial xlPasteAll
 
         Else
         If Not Application.Intersect(Target, Range(Range("L7"), Range("L65000").End(xlUp))) Is Nothing Then
              If Cells(Target.Row, 10) <> "" Then
              If MsgBox("Etes-vous certain de vouloir supprimer ?", vbYesNo + vbQuestion) = vbYes Then
                ' ==============> Le bout de code pour ragmaxone <=============
 
 
                    Dim maCel3 As Range
                    Set maCel3 = Target
                    maCel3.Offset(0, -2).Clear
                    maCel3.Offset(0, -1).Clear
                    maCel3.Clear
                    maCel3.Offset(0, -2).Interior.Color = RGB(153, 204, 255)
                    maCel3.Offset(0, -1).Interior.Color = RGB(153, 204, 255)
                    maCel3.Interior.Color = RGB(153, 204, 255)
 
               End If
 
               End If
          'Cells(ActiveCell.Offset(3, 1), 1).Clear
 
         Else
         If Not Application.Intersect(Target, Range(Range("K7"), Range("K65000").End(xlUp))) Is Nothing Then
              If Cells(Target.Row, 10) <> "" Then
            Dim resultat2 As String
 
             resultat2 = InputBox("Modification ?", "Titre") 'La variable reçoit la valeur entrée dans l'InputBox
         Dim maCel4 As Range
                    Set maCel4 = Target
 
             If resultat2 <> "" Then 'Si la valeur est différente de "" on recopie le résultat
                    maCel4.Offset(0, -1) = resultat2 ' recopie du résultat'
             End If
          End If
        End If
     End If
  End If
 
  If Not Application.Intersect(Target, Range("S3")) Is Nothing Then
          Increment = 7
             Range("R3").Copy
                While Not (Cells(Increment, 18) = "")
 
                      Increment = Increment + 1
 
                Wend
 
 
         Cells(Increment, 18).PasteSpecial xlPasteAll
        Range("ModifierType").Copy
        Cells(Increment, 19).PasteSpecial xlPasteAll
        Range("SupprimerType").Copy
         Cells(Increment, 20).PasteSpecial xlPasteAll
 
         Else
         If Not Application.Intersect(Target, Range(Range("T7"), Range("T65000").End(xlUp))) Is Nothing Then
              If Cells(Target.Row, 18) <> "" Then
              If MsgBox("Etes-vous certain de vouloir supprimer ?", vbYesNo + vbQuestion) = vbYes Then
                ' ==============> Le bout de code pour ragmaxone <=============
 
 
 
                    Dim maCel5 As Range
                    Set maCel5 = Target
                    maCel5.Offset(0, -2).Clear
                    maCel5.Offset(0, -1).Clear
                    maCel5.Clear
                    maCel5.Offset(0, -2).Interior.Color = RGB(153, 204, 255)
                    maCel5.Offset(0, -1).Interior.Color = RGB(153, 204, 255)
                    maCel5.Interior.Color = RGB(153, 204, 255)
 
               End If
               End If
          'Cells(ActiveCell.Offset(3, 1), 1).Clear
 
         Else
         If Not Application.Intersect(Target, Range(Range("S7"), Range("S65000").End(xlUp))) Is Nothing Then
              If Cells(Target.Row, 18) <> "" Then
            Dim resultat3 As String
 
             resultat3 = InputBox("Modification ?", "Titre") 'La variable reçoit la valeur entrée dans l'InputBox
         Dim maCel6 As Range
                    Set maCel6 = Target
 
             If resultat3 <> "" Then 'Si la valeur est différente de "" on recopie le résultat
                    maCel6.Offset(0, -1) = resultat3 ' recopie du résultat'
             End If
          End If
        End If
     End If
  End If
 
 
    Application.EnableEvents = True
End Sub

**Sciön** · 22/05/2014, 16h27

Bon eh bien en guise de correctif , mais mis goto 666 .... 666 End Sub

La méthode Intersect de _Application à échoué

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager