XL 2016 Couleur par Assosiation

Amigo

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

Pièces jointes

  • Planning Coloriage Barre - Gestion Abs.xls
    101.5 KB · Affichages: 27

job75

XLDnaute Barbatruc
@fanch55 au post #28 pas de double-clic...

Une solution meilleure avec ce fichier (4) :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Worksheet_BeforeRightClick Target, False
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect([C12:AF31], Target) Is Nothing Then
    Cancel = True
    With Intersect([C12:AF31], Target)
        Intersect(.Cells(1).EntireColumn, .Cells).Select 'seule la 1ère colonne est sélectionnée
    End With
    AfficheMenu 1 + (Target.Column - 3) Mod (Sheets("couleurs").Shapes.Count - 1)
End If
End Sub
Dans tous les cas de sélection une seule colonne (la 1ère) est finalement sélectionnée.
 

Pièces jointes

  • Planning Coloriage Barre - Gestion Abs(4).xls
    92 KB · Affichages: 4

job75

XLDnaute Barbatruc
Cela dit il est vrai que la macro AfficheMenu peut s'exécuter 2 fois puisqu'il y a l'instruction Select.

Ce n'est guère gênant mais si on veut l'éviter ajouter les Application.EnableEvents :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Worksheet_BeforeRightClick Target, False
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect([C12:AF31], Target) Is Nothing Then
    Cancel = True
    Application.EnableEvents = False
    With Intersect([C12:AF31], Target)
        Intersect(.Cells(1).EntireColumn, .Cells).Select 'seule la 1ère colonne est sélectionnée
    End With
    Application.EnableEvents = True
    AfficheMenu 1 + (Target.Column - 3) Mod (Sheets("couleurs").Shapes.Count - 1)
End If
End Sub
 

job75

XLDnaute Barbatruc
Bon dans ce fichier (5) j'ai remplacé Target.Column par Selection.Column, c'est plus logique :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Worksheet_BeforeRightClick Target, False
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect([C12:AF31], Target) Is Nothing Then
    Cancel = True
    Application.EnableEvents = False
    With Intersect([C12:AF31], Target)
        Intersect(.Cells(1).EntireColumn, .Cells).Select 'seule la 1ère colonne est sélectionnée
    End With
    Application.EnableEvents = True
    AfficheMenu 1 + (Selection.Column - 3) Mod (Sheets("couleurs").Shapes.Count - 1)
End If
End Sub
 

Pièces jointes

  • Planning Coloriage Barre - Gestion Abs(5).xls
    108.5 KB · Affichages: 5

Amigo

XLDnaute Occasionnel
Bonjour Pierrejean, Job75, GALOULALOU, franch55, le Forum
D'abord j'espère que vous allez bien.
Etant donné que mon fichier est un suivi d'absences, quand je change l'année les couleurs restent dans les cases.
Y-a-t-il un moyen de supprimer les couleurs quand je débute une nouvelle année (bien sûr avant je sauvegarde le fichier de l'année en cours ;) ) ?
Cordialement

@franch55
Merci pour cette nouvelle version
Cordialement
Amigo
 

job75

XLDnaute Barbatruc
Bonjour Amigo, le forum,

Je pense que vous êtes capable de trouver ce code tout seul :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B1]) Is Nothing Then Exit Sub
With [C12:AF31]
    .ClearContents
    .Interior.ColorIndex = xlNone
End With
End Sub
A+
 

Statistiques des forums

Discussions
299 847
Messages
1 979 548
Membres
206 771
dernier inscrit
Charles Fabre