XL 2016 Couleur par Assosiation

[Amigo]

Bonjour Le Forum
J’espère que vous êtes bien protégés. Je viens vers vous pour exposer mon problème.
J’ai adapté le fichier ci-joint (Propriétaire M. Boisgontier = Merci à Lui) pour mes besoins de gérer les absences de 3 Associations différentes. Par contre les adhérents peuvent être dans les 3 associations.
Mon souhait d’adapter le code pour que quand je clique dans la zone d’une association je n’aurai que la couleur attitrée à cette association et l’option « Effacer » seulement.
Par exemples :

Asso1 => couleur Bleu + Effacer
Asso2 => couleur Rouge + Effacer
Asso3 => couleur Or + Effacer

Merci par avance
Amigo

 

[Amigo]

Re
@ Job75
Merci beaucoup pour cette nouvelle version et votre contribution.
Effectivement le fichier d'origine de JB comportait plusieurs couleurs.
Bien Cordialement
Amigo

 

[pierrejean]

Re
Bravo Gerard pour cette version évolutive !!!

 

[fanch55]

Une autre approche :
Définition d'un nom "Entete_Asso" regroupant les cellules des associations en ligne 11.
Définition d'un nom "Personnel" regroupant les cellules de la zone à "cliquer", ce qui permet l'extension automatique de celle-ci en cas d'insertion de nouveaux participants .
Coloration des cellules de l'Entete_Asso
Adaptation de la fonction couleurs .
La coloration de la zone à cliquer est dépendante de la couleur de "l’entête" de colonne .

La sélection "horizontale" a été limitée à l'action Effacer ( pas de sens pour la coloration ) .

Voilà voilà, le confinement nous rend "anodinement" prolifique ...

 

[Amigo]

Bonjour Pierrejean, Job75, GALOULALOU, franch55, le Forum
@ franch55
Merci beaucoup pour votre version et contribution. c'est un nouvel angle de réflexion qui s'ouvre.
Une petite remarque (si vous me permettez) après quelques essais sur toutes les versions (jeanpierre, Job75 et vous) :
- En appliquant une couleur dans une cellule par erreur et en restant sur cette même cellule pour la modifier, le menu ne s'affiche pas si je clique. je dois cliquer sur une autre cellule et après revenir sur la cellule à modifier pour avoir le menu.
Je vous souhaite une bonne journée et prenez soin de vous.
Cordialement
Amigo

 

[pierrejean]

Re
La version de Job75 (a mon avis la meilleure) avec possibilité de retrouver le menu par double click sur la cellule

 

[fanch55]

Ah ça, c'est le problème classique d'excel pour les feuilles,
il n'y a pas d'événement click ou mousedown pour un worksheet .
On utilise généralement le selectionchange mais celui-ci ne se déclenche pas pour une cellule déjà sélectionnée.
Le moyen éventuel, c'est de déplacer la sélection à la fin de la macro associée à OnRun,
la question c'est où: la cellule à coté, au dessus , en dessous ou ailleurs ?

Public Sub Colore_Me(Couleur As Long)
    
    If Couleur = xlNone _
    Then Selection.Interior.ColorIndex = Couleur _
    Else Selection.Interior.Color = Couleur
    ActiveSheet.Calculate
    
' =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
    Application.EnableEvents = False                        ' pour ne pas redéclencher le SelectionChange
        Application.Goto Selection.Offset(1, 1).Cells(1)    ' déplacement du select
    Application.EnableEvents = True                         ' réactivation des événements
' =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
   
End Sub

Une autre solution c'est d'utiliser un shape qui recouvrirait temporairement la zone sélectionnée après la macro associée à Onrun, je vais étudier ça ...

 

[fanch55]

Bonjour PierreJean, Job75
Je n'ai pas vu qu'on pouvait réenclencher l'action par un double-clic sur une cellule sélectionnée.
En tout cas, ça ne marche pas chez moi.
D'autre part, j'ai aléatoirement l'erreur ci-dessous quand je double-clique de trop sur une cellule:

Difficile de débogger ce cas car le pas à pas est correct ( peut-être un timing )

 

[pierrejean]

Re
Ce que j'ai traité c'est la possibilité par double click de retrouver le menu apres une premiere utilisation erronée (a priori la demande de Amigo)
Quant a l'erreur je ne l'ai pas !!!

 

[Amigo]

Bonjour Pierrejean, Job75, GALOULALOU, franch55, le Forum
@ pierrejean
Merci ca fonctionne le double-click. Idem je n'ai pas l'erreur
@franch55
j'ai mis dans le fichier le code du poste #21 mais rien n'a changé.
Cordialement
Amigo

 

[fanch55]

Le problème du double-clic sur une cellule :
premier clic -> si cellule pas sélectionnée, evt SelectionChange
second clic --> édition et verrouillage de la cellule ( en parallèle de l'action du premier clic )
Ce qui veut dire que selon la puissance et la mémoire de la machine et du code que doit faire la première macro, le .pastface ne peut pas s'effectuer sur une cellule verrouillée en édition , tout au moins si j'ai bien analysé le déroulement .

Pierrejean:
C'est le fichier de Job75 qui a le souci ( code peut-être plus lent ?), pas le tien .
J'ai essayé tous les fichiers joints, aucun ne traite le double-clic ...
Le double-clic fait réapparaitre le menu chez toi ?

 

[pierrejean]

Re
C'est le fichier du #20 qui est le fichier de Job75 avec double click sur la feuille Tableau

 

[fanch55]

Pierrejean:
OK, c'est celui qui me posait le problème aléatoire selon la vitesse du double-clic.
J'ai tempéré mes doigts et effectivement le double-click fonctionne mais à condition de ne pas laisser Excel entrer en édition dans la cellule en modifiant le code :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect([c12:af31], Target) Is Nothing Then
AfficheMenu 1 + (ActiveCell.Column - 3) Mod (Sheets("couleurs").Shapes.Count - 1)
Cancel = True
End If
End Sub

(je l'avais oublié celui-la à force de me focaliser sur le simple clic)

 

[job75]

Bonjour à tous,

Plutôt que le double-clic il vaut mieux utiliser le clic droit si l'on sélectionne une plage de plusieurs cellules, voyez ce fichier (3) avec le code :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect([C12:AF31], Target) Is Nothing Then
    Intersect([C12:AF31], Target).Select
    AfficheMenu 1 + (Target.Column - 3) Mod (Sheets("couleurs").Shapes.Count - 1)
End If
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect([C12:AF31], Target) Is Nothing Then
    Cancel = True
    Intersect([C12:AF31], Target).Select
    AfficheMenu 1 + (Target.Column - 3) Mod (Sheets("couleurs").Shapes.Count - 1)
End If
End Sub

A+

 

[Amigo]

Encore Merci

 

[fanch55]

Job75:
Testé ton fichier #28.
Toujours le même pb aléatoire de double-clic avec .pasteface (je me sers d'une souris, pas d'un touchpad, le double-clic est rapide ).
Y-a-t-il une raison de re-sélectionner le target dans les evts worksheet ?