Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

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

  • Planning de Présence.xlsm
    40.5 KB · Affichages: 74

susaita

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

JHA

XLDnaute Barbatruc
Bonjour à tous,

Je ne suis pas très bon en code VBA, ci joint une modif, le code est à répéter dans dans la feuille.

Ce n'est pas très compliqué de copier le code dans un nouvel onglet.


JHA
 

Pièces jointes

  • Planning de Présence Rev1.xlsm
    57.5 KB · Affichages: 52

job75

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

  • Planning de Présence(1).xlsm
    46.7 KB · Affichages: 50

susaita

XLDnaute Occasionnel
Bonsoir Job,
Merci pour votre code mais dans l'onglet septembre-2016 je veux juste voir les couleurs sans les abréviations
c'est à dire au lieu de voir AA ou AB avec la couleur je veux juste voir la couleur et cacher l'écriture
 

job75

XLDnaute Barbatruc
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.
 

JHA

XLDnaute Barbatruc
Bonjour à tous,
Bonjour Job75

Tu peux modifier la liste de validation.
Onglet Données/Validation des données/liste:
=SI(JOURSEM(B$9;2)=7;"";Codes)

Dans l'exemple, cela est fait pour l'onglet "Septembre-2016", à toi de l'appliquer sur "Octobre-2016"

JHA
 

Pièces jointes

  • Planning de Présence Rev2.xlsm
    57.1 KB · Affichages: 45

job75

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

  • Planning de Présence(2).xlsm
    44.6 KB · Affichages: 49
Dernière édition:

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…