Tableau Horaires

S

StrikeBEH

XLDnaute Occasionnel
Bonjour à tous,
J'ai fait un tableau pour noter mes horaires en fonction de chaque jour de la semaine.
Tout fonctionne bien apparemment sauf que je n'arrive pas à faire la distinction entre le mardi et le mercredi.
J'aimerai que seul la ligne du mercredi soit surlignée en vert.
Or il se trouve que celle du mardi le soit aussi...

Mieux qu'un long discours, je vous joins mon tableau.
Merci à tous pour votre aide.
 

Pièces jointes

  • Test Tableau.xlsm
    25.8 KB · Affichages: 43
  • Test Tableau.xlsm
    25.8 KB · Affichages: 49
  • Test Tableau.xlsm
    25.8 KB · Affichages: 50
Trier par date Trier par votes
excfl

excfl

XLDnaute Barbatruc
Re : Tableau Horaires

Bonjour le forum,

Faute d'un fichier joint renseigné une proposition :

=JOURSEM(A1)=4

excfl
 

Pièces jointes

  • Mercredi.xlsx
    9.5 KB · Affichages: 31
  • Mercredi.xlsx
    9.5 KB · Affichages: 28
  • Mercredi.xlsx
    9.5 KB · Affichages: 24
Vote positif 0 Vote négatif
Modeste geedee

Modeste geedee

XLDnaute Barbatruc
Re : Tableau Horaires

Bonsour®
Mais quoi ?
Cliquez pour agrandir...
Peut-être n'as-tu pas toi-même ouvert ce lien :
:confused::rolleyes:
Lien supprimé

rien ne dit qu'elle macro activer...
la colonne utilisée pour les mefc n'est pas une date :
comment faire la différence entre "M" mardi et "M" mercredi

:cool: en utilisant des vraies dates, la solution de Excfl devrait résoudre le problème ...
 
Vote positif 0 Vote négatif
S

StrikeBEH

XLDnaute Occasionnel
Re : Tableau Horaires

Puisque tu as visiblement un soucis avec les macros... voila ce que ça donne après l'exécution de la macro.
 

Pièces jointes

  • Test Tableau.xlsm
    27.8 KB · Affichages: 29
  • Test Tableau.xlsm
    27.8 KB · Affichages: 34
  • Test Tableau.xlsm
    27.8 KB · Affichages: 32
Vote positif 0 Vote négatif
S

StrikeBEH

XLDnaute Occasionnel
Re : Tableau Horaires

Au pire, je vous joins tout le code...

Code: 
Option Explicit

Public MoisActuel As String
Public AnnéeActuelle As String
Public DateSelect As String
Public IntV As Long
Const sWd As String = "Heure"
Public j As Integer

Sub FeuilNouveauMois()
'MoisActuel = Format(Date, "mmm yyyy")
'AnnéeActuelle = Format(Date, "yyyy")
'Application.ScreenUpdating = False
'If Sheets(Sheets.Count).Name <> MoisActuel Then
'    Sheets.Add After:=Sheets(Sheets.Count)
'    Sheets(Sheets.Count).Name = MoisActuel
'    Sheets(MoisActuel).Tab.Color = 39423
    CreationTableau
'End If
End Sub

Sub CreationTableau()

MoisActuel = Format(Date, "mmm yyyy")
Columns("A:A").ColumnWidth = 2
Columns("B:B").ColumnWidth = 6 '4
Columns("C:C").ColumnWidth = 6
Columns("D:D").ColumnWidth = 16
Columns("E:E").ColumnWidth = 4
Columns("F:G").ColumnWidth = 11
Columns("H:S").ColumnWidth = 6
Columns("T:T").ColumnWidth = 2

Rows("1:1").RowHeight = 12
Dim CheminLogo As String
Range("B2:S4,B5:S5,H6:I6,J6:K6,L6:M6,N6:O6,P6:Q6,R6:S6,U2:V2,W2:X2,U3:V3,W3:X3,U4:V4,W4:X4,_
U5:V5,W5:X5,U6:V6,W6:X6").MergeCells = True
With Range("T2:W6")
    .HorizontalAlignment = xlRight
    .Offset(, 2).HorizontalAlignment = xlLeft
    With .Resize(, 4)
        .VerticalAlignment = xlCenter
        .Font.Bold = True
    End With
End With
    
Dim Form$, i&, arrSTR
arrSTR = Array("Date", "Service", "Ligne", "Type", sWd & " Début" & Chr(10) & "de Service", sWd & " Fin" _
& Chr(10) & "de Service", "Nb " & sWd & "s" & Chr(10) & "Travaillées", sWd & "s" & Chr(10) & "de jour", _
sWd & "s" & Chr(10) & "de nuit", sWd & "s" & Chr(10) & "à 150%", sWd & "s" & Chr(10) & "à 200%", sWd & "s" _
& Chr(10) & "Sam/Dim")
With Range("B2:S4,B5:S5,B6,C6,D6,E6,F6,G6,H6,I6,J6,K6,L6,M6,N6,O6,P6,Q6,R6,S6")
    .BorderAround 1, 4, -4105: .Interior.Color = 39423
    .Font.Size = 10: .Font.Bold = True
    .HorizontalAlignment = -4108: .VerticalAlignment = -4108
End With
    
Range("B5:M5").HorizontalAlignment = xlCenter
Range("B5") = StrConv(Format(Date, "mmmm yyyy"), vbUpperCase)

For i = 0 To 6
Cells(6, Chr(66 + i)) = arrSTR(i)
Next i

j = 1
For i = 7 To 11
Cells(6, Chr(66 + i + j)) = arrSTR(i)
j = j + 1
Next i
  
IntV = CLng(Day(DateSerial(Year(Date), Month(Date) + 1, 0)))
Form = "DATE(YEAR(TODAY()),MONTH(TODAY()),ROW()-6)"

With Range("B7")
    .Resize(IntV + 1, 12).Clear
    With .Resize(IntV + 1, 18)
        .Font.Size = 10
        .HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter
        .BorderAround 1, 4, -4105: .Borders(11).LineStyle = 1: .Borders(3).LineStyle = 1
        With Range(Cells(IntV + 7, 2), Cells(IntV + 7, 7))
            .MergeCells = True
            .Value = "TOTAUX"
        End With
        With Range(Cells(IntV + 7, 2), Cells(IntV + 7, 19))
            .BorderAround 1, 4, -4105: .Borders(11).LineStyle = 1
            .Font.Bold = True: .Interior.Color = RGB(255, 130, 0) '39423
        End With
    End With
    With .Resize(IntV, 1)
        .Font.Bold = True
        .FormulaR1C1 = "=TEXT(" & Form & ",""jj"" & "" "") & MID(""DLMMJVS"",WEEKDAY(" & Form & "),1)"
        .Value = .Value
        With .Offset(, 1)
            .Font.Bold = True
            'With .Offset(, 8)
                '.FormatConditions.Add Type:=2, Formula1:="=Droite($B7)=""L"""
                '.FormatConditions.Add Type:=2, Formula1:="=Droite($B7)=""M"""
                '.FormatConditions.Add Type:=2, Formula1:="=Droite($B7)=""J"""
                '.FormatConditions.Add Type:=2, Formula1:="=Droite($B7)=""V"""
                '.FormatConditions(1).Interior.ThemeColor = 2
                '.FormatConditions(2).Interior.ThemeColor = 2
                '.FormatConditions(3).Interior.ThemeColor = 2
                '.FormatConditions(4).Interior.ThemeColor = 2
                '.FormatConditions(.FormatConditions.Count).SetFirstPriority
            'End With
        End With
    End With
    With .Resize(IntV, 18)
        .FormatConditions.Add Type:=2, Formula1:="=Droite($B7)=""S"""
        .FormatConditions.Add Type:=2, Formula1:="=Droite($B7)=""D"""
        .FormatConditions.Add Type:=2, Formula1:="=Droite($B7)=""M""" ', Formula2:="=Droite($B7)=""J"""
        .FormatConditions(1).Interior.ColorIndex = 37
        .FormatConditions(2).Interior.ColorIndex = 36
        .FormatConditions(3).Interior.ColorIndex = 35
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
    End With
End With
        
Dim Ddate As Long, Ddebut As Long, Dfin As Long, PAQ As Long
Dim An As Integer, Dstat As String, Dcolor As Long
An = Year(Date)
PAQ = Evaluate("=DATE(" & An & ",3,29.56+0.979*MOD(204-11*MOD(" & An & ",19),30)- WEEKDAY(DATE(" & An & ",3,28.56+0.979*MOD(204-11*MOD(" & An & ",19),30))))")
Ddebut = DateSerial(An, Month(Date), 1)
Dfin = DateSerial(An, Month(Date) + 1, 0)
i = 1
For Ddate = Ddebut To Dfin
Select Case Ddate
    Case DateSerial(An, 1, 1) _
            , DateSerial(An, 5, 1) _
            , DateSerial(An, 7, 21) _
            , DateSerial(An, 8, 15) _
            , DateSerial(An, 11, 1) _
            , DateSerial(An, 11, 11) _
            , DateSerial(An, 12, 25) _
            , (PAQ + 1) _
            , (PAQ + 39) _
            , (PAQ + 50)
    Range("E" & i + 6) = "JF"
    With Range("B" & i + 6, "S" & i + 6)
    .Font.Bold = True
    .Font.Color = vbRed
    End With
'    Range("B" & i + 6, "S" & i + 6).Interior.Color = vbRed
End Select
i = i + 1
Next Ddate
    
    
    Range("H" & 7, "H" & IntV + 7).NumberFormat = "hh:mm"
    Range("H" & IntV + 7, "H" & IntV + 7).NumberFormat = "[hh]:mm"
    
    Range("I" & 7, "I" & IntV + 7).NumberFormat = "0.00"
'    Range("I" & IntV + 7, "I" & IntV + 7).NumberFormat = "0.00"

    Range("J" & 7, "J" & IntV + 7).NumberFormat = "hh:mm"
    Range("J" & IntV + 7, "J" & IntV + 7).NumberFormat = "[hh]:mm"
    
    Range("K" & 7, "K" & IntV + 7).NumberFormat = "0.00"
'    Range("K" & IntV + 7, "K" & IntV + 7).NumberFormat = "0.00"
    
    Range("L" & 7, "L" & IntV + 7).NumberFormat = "hh:mm"
    Range("L" & IntV + 7, "L" & IntV + 7).NumberFormat = "[hh]:mm"
    
    Range("M" & 7, "M" & IntV + 7).NumberFormat = "0.00"
'    Range("M" & IntV + 7, "M" & IntV + 7).NumberFormat = "0.00"
    
    Range("N" & 7, "N" & IntV + 7).NumberFormat = "hh:mm"
    Range("N" & IntV + 7, "N" & IntV + 7).NumberFormat = "[hh]:mm"
    
    Range("O" & 7, "O" & IntV + 7).NumberFormat = "0.00"
'    Range("O" & IntV + 7, "O" & IntV + 7).NumberFormat = "0.00"
    
    Range("P" & 7, "P" & IntV + 7).NumberFormat = "hh:mm"
    Range("P" & IntV + 7, "P" & IntV + 7).NumberFormat = "[hh]:mm"
    
    Range("Q" & 7, "Q" & IntV + 7).NumberFormat = "0.00"
'    Range("Q" & IntV + 7, "Q" & IntV + 7).NumberFormat = "0.00"
    
    Range("R" & 7, "R" & IntV + 7).NumberFormat = "hh:mm"
    Range("R" & IntV + 7, "R" & IntV + 7).NumberFormat = "[hh]:mm"
    
    Range("S" & 7, "S" & IntV + 7).NumberFormat = "0.00"
'    Range("S" & IntV + 7, "S" & IntV + 7).NumberFormat = "0.00"
    
    Range("H" & IntV + 7).FormulaR1C1 = "=SUM(R[-1]C:R[" & -IntV & "]C)"
    Range("I" & IntV + 7).FormulaR1C1 = "=SUM(R[-1]C:R[" & -IntV & "]C)"
    Range("J" & IntV + 7).FormulaR1C1 = "=SUM(R[-1]C:R[" & -IntV & "]C)"
    Range("K" & IntV + 7).FormulaR1C1 = "=SUM(R[-1]C:R[" & -IntV & "]C)"
    Range("L" & IntV + 7).FormulaR1C1 = "=SUM(R[-1]C:R[" & -IntV & "]C)"
    Range("M" & IntV + 7).FormulaR1C1 = "=SUM(R[-1]C:R[" & -IntV & "]C)"
    Range("N" & IntV + 7).FormulaR1C1 = "=SUM(R[-1]C:R[" & -IntV & "]C)"
    Range("O" & IntV + 7).FormulaR1C1 = "=SUM(R[-1]C:R[" & -IntV & "]C)"
    Range("P" & IntV + 7).FormulaR1C1 = "=SUM(R[-1]C:R[" & -IntV & "]C)"
    Range("Q" & IntV + 7).FormulaR1C1 = "=SUM(R[-1]C:R[" & -IntV & "]C)"
    Range("R" & IntV + 7).FormulaR1C1 = "=SUM(R[-1]C:R[" & -IntV & "]C)"
    Range("S" & IntV + 7).FormulaR1C1 = "=SUM(R[-1]C:R[" & -IntV & "]C)"

'Sheets(MoisActuel).ScrollArea = "A1:Z40"
Application.ScreenUpdating = True
End Sub
 
Vote positif 0 Vote négatif
Modeste geedee

Modeste geedee

XLDnaute Barbatruc
Re : Tableau Horaires

Bonsour®

Moi... des soucis avec les macros(*) ??
pas de possibilité de créer le tableau à une autre période que le mois en cours
pas de possibilité de choisir le mois ni l'année

Excel est d'abord un tableur, la connaissance du B.A. BA des formules permet de façon simple d'éviter une programmation "spaghetti"...

au pire :
Cliquez pour agrandir...
:cool:
l'utilisation d'une feuille type permet par simple recopie la création d'un tableau pour n'importe quel mois ou année...
Je me comprends ...:rolleyes:
 

Pièces jointes

  • tableau-horaires.xlsm
    32.2 KB · Affichages: 29
Vote positif 0 Vote négatif
S

StrikeBEH

XLDnaute Occasionnel
Re : Tableau Horaires

Bonsoir Modeste,
Je voudrai le faire en VBA et non pas en tapant des formules pour chaque case !
Quant au fait que l'on ne puisse pas choisir un mois spécifique, c'est fait exprès puisque je ne connais pas mes horaires un mois à l'avance mais juste trois jours à l'avance...
Et je ne comprends pas pourquoi cela pose un problème pour essayer de répondre à ma question initiale...
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

D
  • Résolu(e)
Microsoft 365 planning repos tournant
Réponses
5
Affichages
285
piga25
piga25
N
  • Résolu(e)
Microsoft 365 Copie de données d'une feuille à une autre
Réponses
4
Affichages
188
Cousinhub
Cousinhub
M
  • Question
XL 2019 Création tableau excel
Réponses
5
Affichages
500
mmmmp
M
F
  • Question
Microsoft 365 Copie de couleur de cellules
Réponses
3
Affichages
182
gbinforme
G
A
  • Question
XL 2016 Contrôle de la pose de 10 jours de congés consécutifs
Réponses
5
Affichages
343
djidji59430
djidji59430
L
  • Résolu(e)
XL 2019 Mise en forme conditionnelle, jours de la semaine
Réponses
14
Affichages
842
Deadpool_CC
Deadpool_CC
Phoenix23
  • Question
XL 2016 Conversion de temps en journée de travail
Réponses
2
Affichages
177
Phoenix23
Phoenix23
J
  • Question
Power Query Aide - Fonctions pour afficher le détail des inscrits (nom, prénom date de naissance) parmi une liste de différents stages.
Réponses
6
Affichages
432
Hasco
Hasco
H
  • Question
Microsoft 365 Mise en forme conditionnelle sur autre tableau
Réponses
2
Affichages
214
hbb
H
A
  • Question
Microsoft 365 Contrôle technique véhicules utilitaires
Réponses
4
Affichages
161
Aleph8
A

Membres actuellement en ligne

20 membres et 351 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 239
Messages
2 086 497
Membres
103 236
dernier inscrit
Menni