Petit problème avec une macro pour sélectionner une cellule

[Magic_Doctor]

Bonsoir à tous,

J'avais trouvé, probablement dans la BD du forum, une macro fort astucieuse pour sélectionner ou déselectionner une cellule.
La voici in extenso :

Sub IN_EXclure()
For Each cell In Selection.Cells
'For Each cell In Range("Effectif")
With cell.Interior
' cette condition doit etre la même que celle utilisée dans la function CalcValide
If .Pattern <> xlLightUp Then 'ajoute un motif rayures rouge
.Pattern = xlLightUp
.PatternColorIndex = 3
Else 'supprime le motif
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End If
End With
Next
ActiveSheet.Calculate 'recalcule la feuille
End Sub

Quelle que soit la cellule sélectionnée dans la feuille, quand on appuie sur le bouton auquel on a attribué la macro, la cellule est rayée en rouge. On réappui sur le bouton et la cellule redevient normale.
Je voudrais l'adapter pour une feuille de calcul statistique.
D'une part je voudrais que cette macro ne fonctionne que pour une plage de cellule (une colonne de 200 cellules) que j'ai nommée "Effectif". Si on sélectionne n'importe quelle cellule de la feuille qui n'appartienne pas à la plage "Effectif", il ne se passera alors rien.
D'autre part, je voudrais que lorsque une cellule de la plage en question est bariolée, alors dans la cellule qui se trouve immédiatement à sa gauche apparaisse le chiffre 1. Quand on débariole la cellule, alors apparaisse le chiffre 0. Je pense que pour y arriver il faut utiliser la fonction offset...

Enfin, merci pour toute aide ou conseil

 

[GIBI]

Re : Petit problème avec une macro pour sélectionner une cellule

Bonsoir,

ta macro fonctionne (ou alors tu as oublié de virer le commentaire!)
Je t'ai juste ajouté le forçage de la cellule d'à coté

Sub IN_EXclure()
 
For Each cell In Range("Effectif")
  With cell.Interior
    
    If .Pattern <> xlLightUp Then 'ajoute un motif rayures rouge
       .Pattern = xlLightUp
       .PatternColorIndex = 3
       cell.Offset(0, 1) = 1 ' <== 1 dans la colonne à coté
    Else 'supprime le motif
      .Pattern = xlSolid
      .PatternColorIndex = xlAutomatic
       cell.Offset(0, 1) = 0 ' <== 0 dans la colonne à coté
    End If
  End With
Next

ActiveSheet.Calculate 'recalcule la feuille
End Sub

GIBI

 

[Magic_Doctor]

Re : Petit problème avec une macro pour sélectionner une cellule

Merci pour ton coup de pouce, mais le problème persiste en partie, car quand on appuie sur le bouton dans une cellule de la colonne "Effectif", alors toutes les cellules se modifient, alors que je voudrais que ce soit uniquement celle sélectionnée.

 

[alex67800]

Re : Petit problème avec une macro pour sélectionner une cellule

Bonsoir Magic_Doctor, GIBI,

La méthode If Not Intersect permet de désigner un plage de données dans laquelle la macro s'applique. Je te propose donc cette méthode:

Sub IN_EXclure()
If Not Intersect(ActiveCell, Range("Effectif")) Is Nothing Then
cancel = True
  With ActiveCell.Interior
    If .Pattern <> xlLightUp Then 'ajoute un motif rayures rouge
       .Pattern = xlLightUp
       .PatternColorIndex = 3
       ActiveCell.Offset(0, [COLOR="Red"]-[/COLOR]1) = 1 ': Exit Sub ' <== 1 dans la colonne à coté
       'End If
    Else 'supprime le motif
    If .Pattern = xlLightUp Then 'ajoute un motif rayures rouge
      .Pattern = xlSolid
      .PatternColorIndex = xlAutomatic
       ActiveCell.Offset(0, [COLOR="red"]-[/COLOR]1) = 0 ' <== 0 dans la colonne à coté
    End If
End If
End With
End If

End Sub

A te lire!

Edit:

je voudrais que lorsque une cellule de la plage en question est bariolée, alors dans la cellule qui se trouve immédiatement à sa gauche apparaisse le chiffre 1

Rajouter le signe - avant le 1 comme en rouge dans le code.

 

[Magic_Doctor]

Re : Petit problème avec une macro pour sélectionner une cellule

Bonjor à tous,

Merci Alex, ta routine fonctionne parfaitement.
En revanche, serait-il possible de pouvoir, toujours uniquement dans la colonne "Effectif", sélectionner plusieurs cellules à la fois (contiguës ou pas) pour les barioler ou débarioler toutes à la fois sans devoir le faire une par une ?

 

[mromain]

Re : Petit problème avec une macro pour sélectionner une cellule

bonjour le forum, Magic Doctor

je te propose ça (adapté de la macro de alex)

Sub IN_EXclure()
Dim curCell As Excel.Range
For Each curCell In Selection
If Not Intersect(curCell, Range("Effectif")) Is Nothing Then
    cancel = True
    With curCell.Interior
    If .Pattern <> xlLightUp Then 'ajoute un motif rayures rouge
       .Pattern = xlLightUp
       .PatternColorIndex = 3
       curCell.Offset(0, -1) = 1 ': Exit Sub ' <== 1 dans la colonne à coté
       'End If
    Else 'supprime le motif
    If .Pattern = xlLightUp Then 'ajoute un motif rayures rouge
      .Pattern = xlSolid
      .PatternColorIndex = xlAutomatic
       curCell.Offset(0, -1) = 0 ' <== 0 dans la colonne à coté
    End If
End If
End With
Next curCell
End If

End Sub

à tester

a+

 

[Magic_Doctor]

Re : Petit problème avec une macro pour sélectionner une cellule

Merci mromain pour ta suggestion, l'ennui c'est que ça plante : message d'erreur concernant le next. J'ai essayé de corriger mais sans succés...

 

[mromain]

Re : Petit problème avec une macro pour sélectionner une cellule

ola

essaye de mettre le "Next curCell" après le "End If" (juste avant le "End Sub")
c'est peut-être ça

 

[Magic_Doctor]

Re : Petit problème avec une macro pour sélectionner une cellule

Parfait, ça marche !

Encore merci.