enlever une cellule d'une zone

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

Bonjour,

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

Voici le code :

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
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