XL 2013 Colorer les jours dans un planning de présence (Résolu par JOB75)

  • Initiateur de la discussion Initiateur de la discussion susaita
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

susaita

XLDnaute Occasionnel
Bonjour a tous,
dans le fichier ci-joint j'ai un planning de présence et ce que je souhaite avoir c'est un code vba pour colorer chaque cellule par les couleurs qui se trouvent sur l'onglet DATA, cad quand je choisi un motif d'absence dans la liste que j'ai sur l'onglet septembre-2016 il me donne la couleur qui lui correspond toute en sachant que le code sera valable pour les mois qui vont s'ajouter par la suite.

puis je veux interdire la visualisation de la liste déroulante dans les dimanches

Merci d'avance
 

Pièces jointes

Bonjour JHA,
Merci pour ta réponse mais j'aimerais bien que le code soit en thisworkbook parce que il sera applicable sur tout les mois qui vont s'ajouter
2ème remarque en sélectionnat le motif d'abasence souhaité, dans le résultat je veux cacher les abréviations garder juste la couleur
 
Bonsoir susaita, JHA,

Fichier joint avec dans ThisWorkbook :
Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If IsDate("1-" & Sh.Name) Then
  On Error Resume Next
  For Each Target In Intersect(Target, Sh.Range("B10:AF" & Sh.Rows.Count), Sh.UsedRange) 'si entrées/effacements multiples
    Target.Interior.ColorIndex = xlNone 'RAZ
    Target.Interior.Color = [Codes].Find(Target, , xlValues, xlWhole).Interior.Color
  Next
End If
End Sub
Bonne nuit.
 

Pièces jointes

Re,
Code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If IsDate("1-" & Sh.Name) Then
  On Error Resume Next
  For Each Target In Intersect(Target, Sh.Range("B10:AF" & Sh.Rows.Count), Sh.UsedRange) 'si entrées/effacements multiples
    Target.Interior.ColorIndex = xlNone 'RAZ
    With [Codes].Find(Target, , xlValues, xlWhole)
      Target.Interior.Color = .Interior.Color
      Target.Font.Color = .Font.Color
    End With
  Next
End If
End Sub
Re-bonne nuit.
 
Bonjour susaita, JHA, le forum,
Code:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not IsDate("1-" & Sh.Name) Then Exit Sub
With Sh.Range("B10:AF" & Sh.Rows.Count)
  .Validation.Delete 'RAZ
  If Intersect(ActiveCell, .Cells) Is Nothing Then Exit Sub
End With
On Error Resume Next
If Weekday(ActiveCell(9 - ActiveCell.Row), 2) > 5 Then Else _
  ActiveCell.Validation.Add xlValidateList, Formula1:="=Codes" 'liste de validation
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim c As Range
If Not IsDate("1-" & Sh.Name) Then Exit Sub
Set Target = Intersect(Target, Sh.Range("B10:AF" & Sh.Rows.Count), Sh.UsedRange)
If Target Is Nothing Then Exit Sub
On Error Resume Next
For Each Target In Target 'si entrées/effacements multiples
  Target.Interior.ColorIndex = xlNone 'RAZ
  Target.Font.ColorIndex = xlAutomatic 'RAZ
  Set c = [Codes].Find(Target, , xlValues, xlWhole)
  If c Is Nothing Or Weekday(Target(9 - Target.Row), 2) > 5 Then
    If Target <> "" Then Target = ""
  Else
    Target.Interior.Color = c.Interior.Color
    Target.Font.Color = c.Font.Color
  End If
Next
End Sub
Edit : j'ai revu la macro Workbook_SheetChange.

J'ai aussi revu les MFC, pour les bordures et les week-ends.

Fichier (2).

A+
 

Pièces jointes

Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
8
Affichages
866
Retour