1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
Sub PosRegle()
Dim Fe As Worksheet
Dim Regle As Shape
Dim Label As Shape
Dim LgCol As Single
Dim LgCel As Single
Dim NBSemMax As Integer
Dim SemActuelle As Integer
Dim LaDate As Date
Dim I As Long
Static Jour As Integer
Jour = Jour + 1
If Jour > 7 Then Jour = 1
LaDate = Date + Jour 'aujourd'hui
' LaDate = CDate("01/01/2015") 'début d'année
' LaDate = CDate("31/12/2015") 'fin d'année
Set Fe = ActiveSheet
Set Regle = ActiveSheet.Shapes("Regle")
Set Label = ActiveSheet.Shapes("TxtJour")
With WorksheetFunction
NBSemMax = .WeekNum(DateSerial(Year(Date), 12, 31), 2)
SemActuelle = .WeekNum(LaDate, 2)
End With
Regle.Width = 6.3
Label.TextFrame.Characters.Text = Format(Date + Jour, "dddd d mmm yyyy")
LgCel = Fe.Cells(1, 1).Width
'même largeur que la première colonne si nécessaire !
' LgCol = Fe.Cells(1, 1).ColumnWidth
'
' For I = 2 To NBSemMax
'
' Columns(I).ColumnWidth = LgCol
'
' Next I
Regle.Left = LgCel * SemActuelle - Regle.Width / 2 + (LgCel / 7) * Weekday(LaDate, vbMonday)
Label.Left = Regle.Left + Regle.Width
End Sub |
