Clic gauche - Clic droit --> Couleur cellule

Bonjour,

Après une longue période d’arrêt je me remets à bidouiller Excel, et c'est pas simple.

Mon problème d'aujourd'hui est que je voudrais dans une feuille, modifier la couleur et éventuellement ajouter un texte à une cellule en fonction du clic souris.

En clair:

Clic gauche sur la cellule : couleur "bleue", texte "OK"

Clic droit sur la cellule : couleur "rouge", texte "non OK"

Et ceci que sur certaines cellules de la feuille.

Possible ?

Merci pour votre aide

Bonjour,

l'exemple ici ce fait sur les cellules B2 à D4 à coller dans le VBA de la Feuil1, par contre, c'est clic droit pour NOK et double clic gauche pour OK, je n'ai pas trouvé le simple clic gauche :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Range("b2:d4"), Target) Is Nothing Then

With Selection
 .Value = "OK"
 .Interior.Color = RGB(0, 255, 0)

 End With

End If

End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Range("b2:d4"), Target) Is Nothing Then

With Selection
 .Value = "NOK"
 .Interior.Color = RGB(255, 0, 0)

 End With

End If

End Sub

Niko a écrit :

Bonjour,

l'exemple ici ce fait sur les cellules B2 à D4 à coller dans le VBA de la Feuil1, par contre, c'est clic droit pour NOK et double clic gauche pour OK, je n'ai pas trouvé le simple clic gauche :

Merci, c'est exactement ce que je cherchais.

Et... Y'aurait pas moyen de virer le menu contextuel sur les clics droits ? Je n'y avais pas pensé à celui là

Bonjour,

En reprenant le code pour le click droit

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

    If Not Intersect(Range("b2:d4"), Target) Is Nothing Then
        Cancel = True

         With Selection
         .Value = "NOK"
         .Interior.Color = RGB(255, 0, 0)

         End With

    End If

End Sub

Cordialement,

Leakim

leakim a écrit :

Bonjour, En reprenant le code pour le click droit

Merci, le menu contextuel a disparu.

Je voudrais arriver maintenant à faire deux choses supplémentaires:

1/ Agir sur plusieurs plages de cellules séparées sur la feuille

2/ une fois le double-clic gauche ou le clic droit effectués (surtout le double-clic gauche) , déplacer le "focus" sur la première cellule directement à droite de la cellule traitée.

Pour le premier point, je pars sur ce code, mais ça coince.

Suis je sur la bonne voie ?

Dim r1 As Range, r2 As Range, myMultiAreaRange As Range
Set r1 = Range("H12:H18")
Set r2 = Range("H22:H30")
Set myMultiAreaRange = Union(r1, r2)

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Range(myMultiAreaRange), Target) Is Nothing Then
    With Selection
        .Value = "OK"
        .Interior.Color = RGB(0, 255, 0)
    End With
End If

End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Range(myMultiAreaRange), Target) Is Nothing Then
Cancel = True
    With Selection
         .Value = "NOK"
        .Interior.Color = RGB(255, 0, 0)
    End With
End If

End Sub

Pour le deuxième point, je cherche encore.

A vot'bon coeur m'sieur dames

Voici les modifications pour le 1er point :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Union(Range("h12:h18"), Range("h22:h30")), Target) Is Nothing Then
    With Selection
        .Value = "OK"
        .Interior.Color = RGB(0, 255, 0)
    End With
End If

End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Union(Range("h12:h18"), Range("h22:h30")), Target) Is Nothing Then
Cancel = True
    With Selection
         .Value = "NOK"
        .Interior.Color = RGB(255, 0, 0)
    End With
End If

End Sub

Pour le 2ème point :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Union(Range("h12:h18"), Range("h22:h30")), Target) Is Nothing Then

    With Selection
        .Value = "OK"
        .Interior.Color = RGB(0, 255, 0)
        .Offset(0, 1).Select
    End With

End If

End Sub

Merci !

J'ai tout ce qu'il me faut maintenant.

Toujours aussi efficace ce forum

Bjr,

Je déterre ce sujet qui était résolu, car j'essaie de rajouter un petit truc et je n'y arrive pas.

Le code à Niko fonctionne très bien (bien que je ne comprenne pas trop le Not Intersect... mais je vais apprendre)

En fait, j'ai un but, et une question.

- Le nouveau but: ça serait d'incrémenter le "NOK" du double clic en "NOK (x)" avec "x" de 1 vers 5 pour l'instant.

Pour cela j'ai essayé plein de choses, mais sans succès (c'est pour ça que je ne mets pas de code)

L'important serait de tout retester à chaque double clic car il peut être possible qu' un "NOK" passe "OK" en cas d'erreur par exemple.

La phase suivante serait de reporter ce numéro d'incrément dans les cellules 136/138/140/142/144 car ensuite en face ce numéro seront écrits des commentaires.

La Phase encore suivante... Pensez vous que par exemple si j'ai 3 "NOK" dans la feuille, donc "NOK(1)" "NOK(2)" et "NOK(3)"

avec en bas de ma feuille 3 rappels 1,2,3 et en face de chacun une remarque inscrite.

SI je m'aperçois que "NOK(2)" est résolu ou a été inscrit par erreur et que je le fais basculer à "OK", pensez vous qu'il soit possible

d'automatiquement renommer "NOK(3)" en "NOK(2)", ET dans la liste du bas redistribuer les rappels, avec les remarques correspondantes ?

Je ne sais pas si je suis clair, mais j'espère bien y arriver

- La question : ne serait il pas possible de définir une fois pour toutes tous ces "Range" ( qui comprennent pas mal de cellules fusionnées, je sais pas si c'est important) en une seule variable que je pourrais réutiliser (en fonction de mon talent...)

Voilà... Si vous avez une minute à consacrer à mon cas

merci d'avance

Petit UP ....