XL 2016 Couleur par Assosiation

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
 

Fichiers joints

job75

XLDnaute Barbatruc
Ah oui en plus Sub AfficheMenu(n As Byte) ne va pas, il faut Sub AfficheMenu(n As Integer) au cas où n serait négatif, j'ai corrigé le fichier (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+
 

Amigo

XLDnaute Occasionnel
@job75
Merci, j'ai trouvé celui-ci en ajoutant un bouton
VB:
ub efface()
  Application.ScreenUpdating = False
  On Error Resume Next
  For Each i In Range("C12:AF31")
   If i.Column > 2 And i.Row > 3 Then
     coul_lig = i.Offset(0, -(i.Column - 2)).Interior.ColorIndex
     coul_col = i.Offset(-(i.Row - 2), 0).Interior.ColorIndex
     i.Value = Empty
     Selection.Borders(xlDiagonalUp).LineStyle = xlNone
     If coul_lig = xlNone Or coul_lig = 2 Then
        i.Interior.ColorIndex = xlNone
     Else
        i.Interior.ColorIndex = coul_col
     End If
   End If
   Next i
End Sub
 

Amigo

XLDnaute Occasionnel
Re Job75
Bien sûr ton code est plus simple et efficace que celui que j'ai trouvé en cherchant sur le forum.
 

fanch55

XLDnaute Occasionnel
Salut, le code de Job75 une fois adapté à votre fichier est bien plus simple et rapide.
Attention aux borders, ils concernent également les cellules au dessus , en dessous et à coté de la zone à vider .
 

Amigo

XLDnaute Occasionnel
@fanch55
Par respect de répondre : J'ai adapté ton code dans mon fichier principal en changeant aussi les noms des rectangles par les vrais noms des Assos dans feuille "Couleurs" idem dans le code et j'ai un code d'erreur (voir photo jointe) sur la ligne :
" Case Not Intersect([Personnel], Target) Is Nothing"

Cordialement
Amigo Capture erreur.JPG
 

Amigo

XLDnaute Occasionnel
@job75
Je l'ai trouvé dans mon grenier mais je ne me rappelle plus de son propriétaire.
Promis, Juré parole de scout je ne l'utiliserai plus :)
@+
Amigo
 

fanch55

XLDnaute Occasionnel
@Amigo

1585220595091.png

Si vous utilisez votre propre fichier, il est probable que les zones "nommées" n'existent pas.
A adapter à l'emplacement de celles-ci dans votre fichier et à exécuter 1 seule et unique fois :

Sub Define_Nom()

ActiveWorkbook.Names.Add Name:="Personnel", RefersTo:="=Tableau!$c$12:$af$31"
ActiveWorkbook.Names.Add Name:="Entete_Asso", RefersTo:="=Tableau!$c$11:$ai$11"

End Sub
 

Amigo

XLDnaute Occasionnel
@fanch55
Merci pour ta réponse, effectivement j'ai créé la zone des 2 noms ainsi je suis obligé de mettre la couleur pour chaque entête pour que ca fonctionne.
Merci
@+
Amigo
 

fanch55

XLDnaute Occasionnel
@Amigo

Nouveau fichier alternatif .
Nouveau Onglet "Association" où vous pourrez changer l'intitulé et la couleur des associations .
Les noms des intervenants ont été regroupés dans une zone nommée "Participants" .
Quand vous assignez quelqu'un à une association, non seulement la cellule est coloriée mais elle contient le nom de la personne, vous verrez c'est plus visuellement "parlant" .
Pour redéfinir les zones nommées : module1/Sub Define_Nom .


Bon, je sais, on est loin de la demande initiale,
mais je vois que vous essayez de vous servir de VBA et d'Excel,
si mon code peut vous aider dans votre démarche ....:cool:
 

Fichiers joints

Amigo

XLDnaute Occasionnel
Bonjour Pierrejean, Job75, GALOULALOU, fanch55, le Forum

@fanch55
Merci pour votre nouvelle version. Toutes les idées et contributions sont utiles car ca me fait réfléchir sur la multiplicité des solutions et leurs richesses et me font progresser.

Je me permets de revenir vers vous car je suis en train de faire une synthèse des absences (feuille Synthèse).
je souhaite regrouper par mois et par association le total des absents. j'ai essayé avec la fonction "Couleurs" mais ca me ralenti le calcul et me donne #Valeur dans chaque cellule, pour remédier à ca je suis obligé de cliquer et valider dans chaque calcul . Idem pour la Sommeprod.
Je ne sais pas si par un code VBA serait plus rapide (le nombre des Associations et les adhérents peuvent augmenter.
Cordialement
Amigo
 

Fichiers joints

job75

XLDnaute Barbatruc
Bonjour Amigo,

Puisque les couleurs sont accompagnées par des lettres il suffit de les compter.

Formule en I6 de la feuille Synthèse :
Code:
=NB.SI(INDEX(Tableau!$12:$31;;EQUIV(I$5;Tableau!$9:$9)+LIGNE()-6);"*")
à propager sur la plage I6:R8.

Un code VBA est sans intérêt ici.

Pour les valeurs zéro il y a plusieurs manières de les masquer, je vous laisse faire.

A+
 

Amigo

XLDnaute Occasionnel
@job75
merci Job75 pour cette formule. Pour le Zéro j'utilise format perso : # ##0;;
- Justement j'utilisait Sommeprod pour compter les lettres mais ca ramait.
- j'espère qu'elle est plus légère que la fonction :
"=couleurs(Tableau!C$12:C$31;33)" qui me donnait #Valeur et m'oblige à cliquer et valider pour obtenir le résultat.

- Pour le code VBA, je pensais qu'il sera moins gourmant en mémoire car dans la zone (C2:AF) de la feuille "Tableau" j'ai 6 formules matricielles.
Cordialement
Amigo
 

fanch55

XLDnaute Occasionnel
Salut à tous,
Je ne comprend pas le problème,
Qu'entend-t-on par absent ou absence ? Quelqu'un qui n'a pas été assigné à une association ? ou bien le nombre ou non d'assignation pour une association (ce qui semble plus probable au vu de la feuille synthèse) .
@Amigo
Quel est le genre de fichier que vous avez retenu ?
Si je dois plancher sur qq chose, que ce soit pour le bon ... :rolleyes:
 

Amigo

XLDnaute Occasionnel
Bonjour le Fil, le Forum
@fanch55
dans chaque version il y a des avantages.
La votre définit les zones ce qui rend le fichier plus maniable.
N.B : la feuille synthèse est le cumul des absents aux réunions chaque mois.

@job75
J'ai essayé ta formule en l'appliquant sur les 300 adhérent et le résultat est satisfaisant et ne rame pas trop. Merci.

- Une problématique qui s'impose, lorsque un nouvel adhérent arrive, comment faire pour l'inclure et élargir la zone de saisie sans que à chaque fois je la modifie dans la macro. Idem quand un adhérent quitte une association.

Cordialement

Amigo
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas