erreur sur l'execution de Private Sub Worksheet_Change(ByVal Target As Range)

Version imprimable

bonjour,

J'ai l'habitude de lire les discussions sur ce forum, mais c'est la première fois que je pose une question....car je suis bloquée depuis 2 jours sur le même problème...
Je souhaite que lorsqu'on modifie une des cellules C6, C8, C10, C12, C14 cela change les cellules correspondantes 2 colonnes plus loin. Voici donc ce que j'ai écrit:

Code:

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
Dim i As Byte
Dim LIGNE As Byte
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ERREUR
 
Application.ScreenUpdating = False
Application.EnableEvents = False
 
LIGNE = 6
For i = 1 To 5
 
ActiveSheet.Unprotect
    If Range(Cells(LIGNE, 3), Cells(LIGNE, 3)).Value <> "" Then
        Range(Cells(LIGNE, 5), Cells(LIGNE, 5)).Select
            With Selection.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="OUI,NON"
            .IgnoreBlank = True
            .InCellDropdown = True
            .ShowInput = True
            End With
        Selection.Locked = False
 
    Else
 
        Range(Cells(LIGNE, 5), Cells(LIGNE, 5)).Select
        Selection.ClearContents
        Selection.Validation.Delete
        Selection.Locked = True
        Selection.FormulaHidden = False
 
    LIGNE = LIGNE + 2
    End If
Next i
 
    Call Protect1
    Range("C6").Select
 
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True, AllowUsingPivotTables:=True
 
Application.ScreenUpdating = True
Application.EnableEvents = True
 
ERREUR:
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True, AllowUsingPivotTables:=True
 
Application.ScreenUpdating = True
Application.EnableEvents = True
 
MsgBox "Erreur", vbOKOnly
End Sub

Mais après plusieurs modifications, soit j'ai un message d'erreur, soit la macro ne s'exécute pas...Quelqu'un aurait-il une solution ?
Merci d'avance !

20/11/2015, 11h19
Philippe Tulliez
Bonjour,

Citation:

Mais après plusieurs modifications, soit j'ai un message d'erreur, soit la macro ne s'exécute pas...Quelqu'un aurait-il une solution ?

Si ce n'est pas trop demandé. Quel est ce message d'erreur ?
En attendant ta réponse, lorsque l'on utilise la procédure événementielle Worksheet_Change, il faut avoir à l'esprit que si on écrit dans une ou plusieurs cellules de cette même feuille lorsque l'événement Change se déclenche, on provoque à l'écriture un nouvel événement qui enclenche lui même une nouvelle écriture, qui....
Il faut donc utiliser cette instruction

Code:

Application.EnableEvents = False

pour empêcher l'interception des événements lors de l'écriture.
Attention de remettre la propriété à TRUE à la fin de l'instruction d'écriture

Exemple tiré de l'aide VBA
Code:

1 2 3 Application.EnableEvents = False ActiveWorkbook.Save Application.EnableEvents = True
20/11/2015, 11h30
cellela

Bonjour Philippe,

J'ai bien mis Application.EnableEvents = False et true, mais peut-être est-ce que je ne les ai pas mis au bon endroit ?
Sinon, pour l'instant, il m'affiche la msgbox que j'ai défini pour ERREUR:.
20/11/2015, 11h50
Philippe Tulliez

Bonjour,

Citation:

J'ai bien mis Application.EnableEvents = False et true

C'est vrai, je n'avais pas lu le code en profondeur attendant le n° de cette erreur.

Citation:

Sinon, pour l'instant, il m'affiche la msgbox que j'ai défini pour ERREUR:.

Règle n° 1, en cours de développement il faut éviter de placer un On Error qui forcément masque les erreurs inévitables de conception mais si l'erreur est renvoyée à une étiquette de ligne il suffit d'utiliser l'objet ERR et ses propriétés Description et Number

A lire La gestion des erreurs dans Excel

Il te suffit donc maintenant de publier le n° et message d'erreur ainsi que la ligne où le code bug afin que l'on puisse t'aider efficacement.
20/11/2015, 16h47
HopPopPop
Bonjour à tous,

Ce n'est pas la source d'erreur, mais tu peux éclaircir ton code. Tu utilises une boucle For i de 1 à 5 avec la Variable fixée à 6 que tu ajoutes + 2 à chaque boucle. i ne sert à rien. Tu peux faire :
Code:

1 2 3 For LIGNE = 6 to 14 Step 2 ... Next LIGNE

Dans une procédure événementielle du type "Private Sub Worksheet_Change(ByVal Target As Range)", on peut facilement utiliser l'instruction "Application.Intersect".
On obtiendrait cela à tester :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Dim Plage As Range
Set Plage = Range("C6,C8,C10,C12,C14")
 
If Not Application.Intersect(Target, Plage) Is Nothing Then
ActiveSheet.Unprotect
    If Range(Cells(Target.Row, 3), Cells(Target.Row, 3)).Value <> "" Then
        Range(Cells(Target.Row, 5), Cells(Target.Row, 5)).Select
            With Selection.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="OUI,NON"
            .IgnoreBlank = True
            .InCellDropdown = True
            .ShowInput = True
            End With
        Selection.Locked = False
    Else
        Range(Cells(Target.Row, 5), Cells(Target.Row, 5)).Select
        Selection.ClearContents
        Selection.Validation.Delete
        Selection.Locked = True
        Selection.FormulaHidden = False
     End If
End If

20/11/2015, 18h01
cellela

Merci à tous pour ces précieuses informations que j'ignorais...je teste et je reviens vers vous !

Bonjour,

Teste ceci :

Code:

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
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
 
    If Intersect(Target, Range("C6,C8,C10,C12,C14")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub
 
    ActiveSheet.Unprotect
 
    If Target.Value <> "" Then
 
        With Target.Offset(, 2).Validation
 
            .Delete
            .Add xlValidateList, xlValidAlertStop, xlBetween, "OUI,NON"
            .IgnoreBlank = True
            .InCellDropdown = True
            .ShowInput = True
 
        End With
 
        Target.Offset(, 2).Locked = False
 
    Else
 
        With Target.Offset(, 2)
 
            Application.EnableEvents = False
            .ClearContents
            Application.EnableEvents = True
 
            .Validation.Delete
            .Locked = True
            .FormulaHidden = False
 
        End With
 
    End If
 
    Call Protect1
 
End Sub

Sache aussi que ceci :

Code:

1
2
 
Range(Cells(Target.Row, 3), Cells(Target.Row, 3))

ne sert à rien car c'est la même cellule qui borne la plage, ça revient tout simplement à ceci :

Code:

1
2
 
Cells(Target.Row, 3)

22/11/2015, 19h41
cellela
bonsoir,

Effectivement, j'ai testé et ça marche très bien aussi avec
Code:

1 2 If Cells(Target.Row, 3).Value <> "" Then Cells(Target.Row, 5).Select
Merci pour ces précieux conseils !

Sylvie