Bordures selon la date
Résolu
Newbeee
Messages postés
2
Statut
Membre
-
Newbeee Messages postés 2 Statut Membre -
Newbeee Messages postés 2 Statut Membre -
Bonjour,
Je suis une trèèès grande débutante en vba, mais j'aimerais comprendre comment, sur un calendrier, mettre des bordures gauches épaisses sur les colonnes correspondants aux jours 1, 8, 15, 22 de chaque mois.(le calendrier est sur la ligne 1 à partir de la colonne E, donc 1/01/2018 est en E1).
Ma tentative:
Merci pour votre aide!
Je suis une trèèès grande débutante en vba, mais j'aimerais comprendre comment, sur un calendrier, mettre des bordures gauches épaisses sur les colonnes correspondants aux jours 1, 8, 15, 22 de chaque mois.(le calendrier est sur la ligne 1 à partir de la colonne E, donc 1/01/2018 est en E1).
Ma tentative:
Sub SeparationPeriode()
Dim lig As Integer
Dim col As Integer
DerCol = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
DerLig = Range("A" & Rows.Count).End(xlUp).Row
For lig = 1 To 1
For col = 5 To DerCol
If DateSerial( _
Year(dtmDate), Month(dtmDate), 1) Then Range("col:col").Borderleft _
ColorIndex:=1, Weight:=xlThick
ElseIf Day(Date) = 7 Then Range("col:col").Borderleft _
ColorIndex:=1, Weight:=xlThick
ElseIf Day(Date) = 15 Then Range("col:col").Borderleft _
ColorIndex:=1, Weight:=xlThick
ElseIf Day(Date) = 22 Then Range("col:col").Borderleft _
ColorIndex:=1, Weight:=xlThick
Else: Range("col:col").Borders.LineStyle = xlNone
End If
Next
End Sub
Merci pour votre aide!
1 réponse
-
Bonjour
A tester, (cadre sur 20 lignes, à modifier selon besoin)
Sub Cadre() Dim i%, Dc% Dc = Cells(1, Columns.Count).End(xlToLeft).Column 'n° de la dernière colonne non vide de la ligne 1 For i = 5 To Dc If Day(Cells(1, i)) = 1 Or Day(Cells(1, i)) = 8 Or Day(Cells(1, i)) = 15 Or Day(Cells(1, i)) = 22 Then Range(Cells(1, i), Cells(20, i)).Select With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlMedium End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlMedium End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlMedium End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlMedium End With End If Next i End Sub