Discussion :

[marco62118]

Bonjour à toutes et tous


Je crée une zone de cellules excel avec un clic droit de la souris sur les cellules qui m'intéressent.
à chaque clic je fais une union avec la zone précédente. Ceci fonctionne très bien!
Mais Je voudrais si je clique sur une cellule qui existe dans la zone elle soit enlevée de cette zone. c'est là que je bloque.

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
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)   
        Cancel = True  
        If nb_cel_zone = 9 Then
            MsgBox "vous devez changer de zone"
            Exit Sub
        Else
            If nb_cel_zone = 0 Then
                Set zone = Target
                Target.Interior.Color = couleur
                nb_cel_zone = nb_cel_zone + 1
                Target.Value = nb_cel_zone
            Else
                If Not Intersect(Target, zone) Is Nothing Then
                    Target.Interior.Color = couleur_vide 
                    nb_cel_zone = nb_cel_zone - 1
                    Target.Value = ""
                    ici il faudrait que je puisse enlever la "target" de la zone 
                Else
                    Target.Interior.Color = couleur
                    nb_cel_zone = nb_cel_zone + 1
                    Target.Value = nb_cel_zone
                    Set zone = Union(zone, Target)
                End If
                
            End If
        End If
        If nb_cel_zone = 9 Then
            zone.Name = nom_zone
        End If

End Sub

[pijaku]

Bonjour,

A voir : https://www.developpez.net/forums/d1...les-d-plage-b/

Voici le code :

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
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)   
        Cancel = True  
        If nb_cel_zone = 9 Then
            MsgBox "vous devez changer de zone"
            Exit Sub
        Else
            If nb_cel_zone = 0 Then
                Set zone = Target
                Target.Interior.Color = couleur
                nb_cel_zone = nb_cel_zone + 1
                Target.Value = nb_cel_zone
            Else
                If Not Intersect(Target, zone) Is Nothing Then
                    Target.Interior.Color = couleur_vide 
                    nb_cel_zone = nb_cel_zone - 1
                    Target.Value = ""
                    ici il faudrait que je puisse enlever la "target" de la zone 
                    Set zone = enlever_plage(zone, Target)
                Else
                    Target.Interior.Color = couleur
                    nb_cel_zone = nb_cel_zone + 1
                    Target.Value = nb_cel_zone
                    Set zone = Union(zone, Target)
                End If
 
            End If
        End If
        If nb_cel_zone = 9 Then
            zone.Name = nom_zone
        End If
 
End Sub
 
    Private Function enlever_plage(a As Range, b As Range) As Range
    Dim AFormula
        Set b = Intersect(a, b)
        If b Is Nothing Then Set enlever_plage = a: Exit Function
        AFormula = a.Formula
        a.Value = "XXX": b.ClearContents
        On Error Resume Next
        Set enlever_plage = a.SpecialCells(xlCellTypeConstants)
        If Err.Number > 0 Then Set enlever_plage = Nothing
        a.Formula = AFormula
    End Function