Déclarer 700 cellules non-contigües dans Range de Worksheet_BeforeRightClick

[Duarig]

Bonjour,
Je souhaite utiliser la fonction Worksheet_BeforeRightClick pour faire afficher lors d'un clic droit une coche dans des cases qui ne sont pas contigües (la présentation du document m'y oblige : pour la colonne y ; y179,y182,y185,y188,y191,y194,y197,y200,y203,y206,y209,y212,y215,y218,y221,y224,y227,y230,y233,y236,y239,y242,y245,y248 cela répété pour 27 colonnes soit 28 x 25 cases donc 700 cellules). J'ai fait l'essai. Cela marche pour un certains nombres de cases mais après une erreur survient (erreur 1004. La méthode Range de l'objet _worksheet a échoué). J'ai essayé en donnant un nom aux différentes séries de cases mais apparemment la méthode Range n'accepte pas les noms de plage.
Que dois-je faire ? D'avance merci

 

[laetitia90]

Re : Déclarer 700 cellules non-contigües dans Range de Worksheet_BeforeRightClick

bonjour Duarig
a mon avis il faut partir sur des boucles en utilisant MOD vu que c'est tous les 3 cellules enfin dans l'exemple donne

 

[Grand Chaman Excel]

Re : Déclarer 700 cellules non-contigües dans Range de Worksheet_BeforeRightClick

Bonjour,

Voici une proposition à adapter à ton cas :

Cette première partie montre comment créer un plage nommée de cellules non contigues à partir de A3, espacées de 3 lignes et 2 colonnes (A3, C3, E3, A6, C6, E6, ...)

Sub TestName()
    Dim rg As Range, rg1 As Range
    Dim i As Integer
    Dim j As Integer
    
    Set rg = Range("A3")
    Set rg1 = rg
    
    For i = 0 To 4
        For j = 0 To 2
            Set rg = Union(rg, rg1.Offset(i * 3, j * 2))
        Next j
    Next i
    
    ActiveWorkbook.Names.Add Name:="PlageX", RefersTo:=rg

End Sub

On peut ensuite utiliser la plage nommées "PlageX" dans la procédure RightClick (met un X dans les cellules définies):

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("PlageX")) Is Nothing Then
        Target = "X"
    End If
End Sub

A+

 

[Duarig]

Re : Déclarer 700 cellules non-contigües dans Range de Worksheet_BeforeRightClick

Merci de cette réponse,
Je vais essayer cela (je débute avec la programmation).
En tout cas, c'est tjrs un plaisir que de voir avec quelle rapidité les gens répondent sur ce site. Le pb c'est que je me sens à chaque fois redevable sans savoir comment faire pour vous remercier...

 

[JNP]

Re : Déclarer 700 cellules non-contigües dans Range de Worksheet_BeforeRightClick

Bonsoir le fil ,
Comme le suggérait Laettitia, une solution plus simple et plus légère ...

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
With Target
If .Column < 25 Or .Column > 53 Then Exit Sub
If .Row < 179 Or .Row > 248 Then Exit Sub
If .Row Mod 3 <> 2 Then Exit Sub
End With
MsgBox "Coucou"
Cancel = True
End Sub

Bonne soirée

 

[Duarig]

Re : Déclarer 700 cellules non-contigües dans Range de Worksheet_BeforeRightClick

Peut-on utiliser dans la méthode Range, plusieurs plages telles que tu les as définies. Si oui, une virgule pour les séparer ?

 

[Duarig]

Re : Déclarer 700 cellules non-contigües dans Range de Worksheet_BeforeRightClick

En fait, il y a 4 fois le même schéma :
7 colonnes (espacées de une colonne : colonne Y, AA, AC, AE, AG, AI, AK) plus une colonne (espacée de 3 : colonne AO). Chaque colonne comporte 25 cases à cocher espacées de 2 lignes (cela commence à la 179, puis 182 jusqu'à 248.
Ce schéma se répéte à la colonne AQ, puis BJ et enfin, CC

 

[Grand Chaman Excel]

Re : Déclarer 700 cellules non-contigües dans Range de Worksheet_BeforeRightClick

Bonsoir duarig,

Voici comment définir toutes les cellules, en considérant qu'il y a 4 schémas :

Premier code :

Sub TestName2()
    Dim rg As Range, rg1 As Range
    Dim i As Integer
    Dim j As Integer
    Dim z As Integer
    
    Set rg = Range("Y179")
    Set rg1 = rg
    
    'Schéma colonne Y
    For i = 0 To 23  'lignes
        For j = 0 To 6  'colonnes
            Set rg = Union(rg, rg1.Offset(i * 3, j * 2))
        Next j
        'Colonne AO
            Set rg = Union(rg, rg1.Offset(i * 3, 16))
    Next i
            
    'Schéma colonne AQ
    Set rg1 = rg1.Offset(0, 18)
    For i = 0 To 23  'lignes
        For j = 0 To 6  'colonnes
            Set rg = Union(rg, rg1.Offset(i * 3, j * 2))
        Next j
        'Colonne AO
            Set rg = Union(rg, rg1.Offset(i * 3, 16))
    Next i
        
    'Schéma colonne BJ
    Set rg1 = rg1.Offset(0, 19)
    For i = 0 To 23  'lignes
        For j = 0 To 6  'colonnes
            Set rg = Union(rg, rg1.Offset(i * 3, j * 2))
        Next j
        'Colonne AO
            Set rg = Union(rg, rg1.Offset(i * 3, 16))
    Next i
        
    'Schéma colonne CC
    Set rg1 = rg1.Offset(0, 19)
    For i = 0 To 23  'lignes
        For j = 0 To 6  'colonnes
            Set rg = Union(rg, rg1.Offset(i * 3, j * 2))
        Next j
        'Colonne AO
            Set rg = Union(rg, rg1.Offset(i * 3, 16))
    Next i
    
    ActiveWorkbook.Names.Add Name:="PlageX", RefersTo:=rg
End Sub

Deuxième code, plus simple au cas où l'espacement entre chaque schéma est de 18 colonnes (Y, AQ, BI et CA):

Sub TestName()
    Dim rg As Range, rg1 As Range
    Dim i As Integer
    Dim j As Integer
    Dim z As Integer
    
    Set rg = Range("Y179")
    Set rg1 = rg
    
    For z = 1 To 4
  
    For i = 0 To 23  'lignes
        For j = 0 To 6  'colonnes
            Set rg = Union(rg, rg1.Offset(i * 3, j * 2))
        Next j
        'Colonne AO
            Set rg = Union(rg, rg1.Offset(i * 3, 16))
    Next i
        Set rg1 = rg1.Offset(0, 18)
    Next z
    
    ActiveWorkbook.Names.Add Name:="PlageX", RefersTo:=rg

End Sub

Note : Étant donné que tu as plusieurs schémas et que l'espacement entre les colonnes n'est pas toujours le même, la solution de Laettitia et JNP ne sera pas aussi simple... Aussi, l'avantage de créer une plage nommée est que même si des colonnes ou des lignes sont ajoutées après, cela n'affectera pas la plage nommée.

A+

 

[JNP]

Re : Déclarer 700 cellules non-contigües dans Range de Worksheet_BeforeRightClick

Re ,

Note : Étant donné que tu as plusieurs schémas et que l'espacement entre les colonnes n'est pas toujours le même, la solution de Laettitia et JNP ne sera pas aussi simple...

Oui et non ...
Un simple test en Select Case permet d'identifier les colonnes discontinues ...

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
With Target
If .Column < 25 Or .Column > 53 Then Exit Sub
If .Row < 179 Or .Row > 248 Then Exit Sub
If .Row Mod 3 <> 2 Then Exit Sub
Select Case .Column
Case 25, 27, 29, 31, 33, 35, 37, 40, 42, 44, 46, 48, 50, 53
Case Else
Exit Sub
End Select
End With
MsgBox "Coucou"
Cancel = True
End Sub

Après, la question se pose plutôt sur le temps de calcul... La méthode Intersect charge-t'elle uniquement les adresses ou la plage en elle-même ? Bref, je dirais qu'il serait intéressant de tester les 2 méthodes (en vérifiant que je ne me suis pas trompé dans les colonnes ...)
Bonne journée