Tableau Horaires

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

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

Modeste geedee

XLDnaute Barbatruc
Re : Tableau Horaires

Bonsour®
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 ...
 

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

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
 

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"...

: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

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:

Discussions similaires

Réponses
5
Affichages
483
Réponses
5
Affichages
321

Membres actuellement en ligne

Statistiques des forums

Discussions
314 450
Messages
2 109 726
Membres
110 552
dernier inscrit
jasson