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
483
piga25
piga25
S
  • Résolu(e)
XL 2010 tableau de cumul automatisé
Réponses
13
Affichages
343
stefiskool
S
C
  • Résolu(e)
Microsoft 365 Graphique charge de travail répartie sur la journée
Réponses
3
Affichages
288
AtTheOne
AtTheOne
S
  • Résolu(e)
XL 2016 Copier/Coller des cellules en multipliant par des cellules sur une autre page
Réponses
3
Affichages
431
migau
migau
N
  • Résolu(e)
Microsoft 365 Copie de données d'une feuille à une autre
Réponses
4
Affichages
397
Cousinhub
Cousinhub
StephCo
  • Question
Autres Diagramme de Gantt avec beaucoup de contraintes (avec LibreOffice) et formule matricielle multicritères
Réponses
2
Affichages
535
Simon 1234
S
AIXELS
  • Résolu(e)
XL 2021 Colorer le mois en cours et le TextBox correspondant
Réponses
7
Affichages
223
AIXELS
AIXELS
M
  • Question
XL 2019 Création tableau excel
Réponses
5
Affichages
637
mmmmp
M
F
  • Question
Microsoft 365 Copie de couleur de cellules
Réponses
3
Affichages
296
gbinforme
G
oinegain
  • Question
Microsoft 365 Condition si mais...
Réponses
5
Affichages
321
JHA
J

Membres actuellement en ligne

7 membres et 63 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
314 450
Messages
2 109 719
Membres
110 551
dernier inscrit
Khyolyanna