Selectionner des plages pour colorer auto.

[herve62]

Bonsoir
J'ai développé un petit fichier d'absences le code est :

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("C5:L22")) Is Nothing Then
With Target
'If Selection.Interior.ColorIndex = 6 Then
'MsgBox " C'est un jour férié , modifiez votre sélection "
'Exit Sub
'End If
If Selection.Interior.ColorIndex = 3 Then
Selection.Interior.ColorIndex = xlNone
Else
Selection.Interior.ColorIndex = 3
End If
End With
End If
End Sub

Mon But est de pouvoir l'intégrer à un fichier plus complexe récupéré ( Ici ..? je sais plus ou) très intéressant , j'y ai déjà apporté des modif
Afin d'avoir une idée ou solution plus rapide que tout seul dans mon coin à chercher??
Comment incorporer ce code dans ce fichier ? la finalité serait de remplacer la couleur , ici en DUR ( rouge=3)
en cliquant sur un fond prédéfini comme Matin =jaune , AM=Bleu
J'aurai CP=jaune, RTT=Orange Maladie=Rouge
Puis de reporter cette couleur en selectionnant une plage ( comme je fais dans le petit bout de code)
Je sais c'est pas évident , mais je pense qu'il y a des BARBA... très compétent pour ce genre de Pb !!!!
merci

 

[Lone-wolf]

Bonsoir à tous

@Hervé : en colonne BB5 met les couleurs et les intitulés, sélectionne la colonne et celle d'à côté et encadre-les avec la couleur 2ème gris de la palette de couleurs(mise en forme >Bordure>Couleur de bordure); ensuite ajoute le code. Pourquoi les encadrés, si tu éfface un des intitulés, la colonne de la semaine perd les lignes du quadrillage. Personnellement, je mettrait la même couleur pour les lignes horizontales du calendrier.

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

If Target.Count < 2 Then Exit Sub
Target.Value = Target(1, 1)
Set c = Range("bb5:bb7").Find(Target(1, 1).Value, LookIn:=xlValues, lookat:=xlPart)
If Not c Is Nothing Then
      For Each cel In Target
      cel.Interior.Color = c.Interior.Color
   Next
   Else
  Selection.Interior.Color = Range("bc7").Interior.Color
End If
Cancel = True
End Sub

 

[herve62]

Bon je fais la pause WE , je reprends Lundi soir
Sinon j'ai tout supprimé le code Feuille1 , mis juste le tien , bien mis en BB5 à 7
Mais je vois RIEN avec le Clic Droit ??
Tu as bien le fichier de départ ? , donc tu peux aussi tester ton code , non ?
Tu pourras me dire pourquoi ça marche pas chez moi !!

 

[Lone-wolf]

Re Hervé

Oui j'ai pris ton fichier, je ne sais pas ce qui cloche chez toi.

 

[herve62]

Bonsoir
Bon j'ai bien avancé !! voir le fichier , en fait après réflexion c'était simple
Mais je ne maitrise pas bien INtersect et je voulais séparer les zones pour chaque mois
Là cela fonctionne pour janvier , je voulais ajouter H7:I35 ...etc
Comment fait-on ? ; sinon j'ai pensé select tout le calendrier , déverrouiller les cel à colorer
puis protéger la feuille ?
Pour terminer ... toujours ces satanées fonctions ( manque de pratique) donc Pb en BA5
je dois faire idem pour les autres calculs
Merci

 

[Lone-wolf]

Bonsoir Hervé

If Not Intersect(Target, Range("D7:E37, H7:I35, L7:M37")) Is Nothing Then pour tous les mois.

 

[herve62]

Merci le Loup !!!!!
Sinon la (les) fonction ?
Une fois une feuille correcte j'ai plus qu'à .......... la multiplier par 12
Avant je devrais vérifier toutes le SUB ( Y a eu un sacré boulot de fait !!!!!!!) pour supprimer l'inutile
Sinon tu as vu cela marche bien ??

 

[Lone-wolf]

Re Hervé

non, je n'ai pas testé.

 

[herve62]

Je termine pour ce soir : Il y a quand même un ALEA !! car en agissant sur les motifs n'importe comment ( choix, selection d'une plage ...etc) , il arrive vite que celui-ci n'est plus reconnu au clic droit et la selection reste en blanc , si je réinitialise mon choix , cela refonctionne ; et c'est là que je pige plus ???? pour éviter que cela ne se reproduise !

 

[herve62]

Bonjour
Même pas une idée , pourquoi ma fonction ne marche pas ?? !