Problem with weeknumbers

X

xsmurf

Board Regular
Joined
Feb 24, 2007
Messages
55
Office Version
  1. 365
Platform
  1. Windows
Hello,

I use the below code for auto-generating a schedule, and its works fine.

But i want a extra line with de weeknumber showed, and i can't get it to work
The making of the line is with this code => .Cells(2, StartPos + Dag).Value = ?
but the code thats need to be on the ?-place , is a mystery for my

can someone help me ?


Option Explicit
Option Base 1

Sub Rooster_5PLD()
Dim Schrikkeljaar As Boolean
Dim Datum As Date, Nieuwjaar As Date, Pasen As Date
Dim Koninginnedag As Date, Bevrijdingsdag As Date, Hemelvaart As Date
Dim Pinksteren As Date, Kerstmis As Date
Dim Ochtend As Integer, Middag As Integer, Nacht As Integer, Ploeg As Integer
Dim StartPos As Long, CDN5Pld As Long, Dag As Long, Maand As Long, Jaar As Long
Dim WeekdagNaam As String
Dim Werkblad As Variant, DagenInMaand As Variant, Dagen5Pld As Variant

Werkblad = Array("Jan", "Feb", "Mrt", "Apr", "Mei", "Jun", _
"Jul", "Aug", "Sep", "Okt", "Nov", "Dec")

Jaar = Range("Nieuwejaar")

DagenInMaand = Array(31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31)

Dagen5Pld = Array(0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335)

StartPos = Range("PersData_Jan").Column - 1

Schrikkeljaar = (Jaar Mod 4 = 0 And Not Jaar Mod 100 = 0) Or (Jaar Mod 400 = 0)

If Schrikkeljaar Then DagenInMaand(2) = 29

Nieuwjaar = DateSerial(Jaar, 1, 1)
Pasen = Paasdag(Jaar)
Koninginnedag = DateSerial(Jaar, 4, 30)
If Weekday(Koninginnedag, vbSunday) = 1 Then Koninginnedag = DateSerial(Jaar, 4, 29)
If Jaar Mod 5 = 0 Then Bevrijdingsdag = DateSerial(Jaar, 5, 5)
Hemelvaart = Pasen + 39
Pinksteren = Pasen + 49
Kerstmis = DateSerial(Jaar, 12, 25)

Ploeg = Range("Ploeg") '1 = Blauw, 2 = Rood, 3 = Geel, 4 = Groen, 5 = Wit

' If Jaar > 2006 And Not Schrikkeljaar Then Dagen5Pld(2) = 32 'Rooster (22123)

Application.ScreenUpdating = False
For Maand = 1 To 12
For Dag = 1 To DagenInMaand(Maand)
Datum = DateSerial(Jaar, Maand, Dag)
Select Case Datum
Case Nieuwjaar
With Sheets(Werkblad(Maand))
.Cells(3, StartPos + Dag).Font.ColorIndex = 1
.Cells(3, StartPos + Dag).Interior.ColorIndex = 3
.Cells(3, StartPos + Dag).Value = "NJ"
.Cells(4, StartPos + Dag).Font.ColorIndex = 1
.Cells(4, StartPos + Dag).Interior.ColorIndex = 3
.Cells(4, StartPos + Dag).Value = Dag
End With
Case Pasen, Pasen + 1
With Sheets(Werkblad(Maand))
.Cells(3, StartPos + Dag).Font.ColorIndex = 1
.Cells(3, StartPos + Dag).Interior.ColorIndex = 3
.Cells(3, StartPos + Dag).Value = "PA"
.Cells(4, StartPos + Dag).Font.ColorIndex = 1
.Cells(4, StartPos + Dag).Interior.ColorIndex = 3
.Cells(4, StartPos + Dag).Value = Dag
End With
Case Koninginnedag
With Sheets(Werkblad(Maand))
.Cells(3, StartPos + Dag).Font.ColorIndex = 1
.Cells(3, StartPos + Dag).Interior.ColorIndex = 3
.Cells(3, StartPos + Dag).Value = "KO"
.Cells(4, StartPos + Dag).Font.ColorIndex = 1
.Cells(4, StartPos + Dag).Interior.ColorIndex = 3
.Cells(4, StartPos + Dag).Value = Dag
End With
Case Bevrijdingsdag
With Sheets(Werkblad(Maand))
.Cells(3, StartPos + Dag).Font.ColorIndex = 1
.Cells(3, StartPos + Dag).Interior.ColorIndex = 3
.Cells(3, StartPos + Dag).Value = "BE"
.Cells(4, StartPos + Dag).Font.ColorIndex = 1
.Cells(4, StartPos + Dag).Interior.ColorIndex = 3
.Cells(4, StartPos + Dag).Value = Dag
End With
Case Hemelvaart
With Sheets(Werkblad(Maand))
.Cells(3, StartPos + Dag).Font.ColorIndex = 1
.Cells(3, StartPos + Dag).Interior.ColorIndex = 3
.Cells(3, StartPos + Dag).Value = "HE"
.Cells(4, StartPos + Dag).Font.ColorIndex = 1
.Cells(4, StartPos + Dag).Interior.ColorIndex = 3
.Cells(4, StartPos + Dag).Value = Dag
End With
Case Pinksteren, Pinksteren + 1
With Sheets(Werkblad(Maand))
.Cells(3, StartPos + Dag).Font.ColorIndex = 1
.Cells(3, StartPos + Dag).Interior.ColorIndex = 3
.Cells(3, StartPos + Dag).Value = "PI"
.Cells(4, StartPos + Dag).Font.ColorIndex = 1
.Cells(4, StartPos + Dag).Interior.ColorIndex = 3
.Cells(4, StartPos + Dag).Value = Dag
End With
Case Kerstmis, Kerstmis + 1
With Sheets(Werkblad(Maand))
.Cells(3, StartPos + Dag).Font.ColorIndex = 1
.Cells(3, StartPos + Dag).Interior.ColorIndex = 3
.Cells(3, StartPos + Dag).Value = "KE"
.Cells(4, StartPos + Dag).Font.ColorIndex = 1
.Cells(4, StartPos + Dag).Interior.ColorIndex = 3
.Cells(4, StartPos + Dag).Value = Dag
End With
Case Else
If Weekday(Datum, vbSunday) = 1 Then
With Sheets(Werkblad(Maand))
.Cells(3, StartPos + Dag).Font.ColorIndex = 1
.Cells(3, StartPos + Dag).Interior.ColorIndex = 35
.Cells(4, StartPos + Dag).Font.ColorIndex = 1
.Cells(4, StartPos + Dag).Interior.ColorIndex = 35
End With
Else
With Sheets(Werkblad(Maand))
.Cells(3, StartPos + Dag).Font.ColorIndex = 1
.Cells(3, StartPos + Dag).Interior.ColorIndex = 35
.Cells(4, StartPos + Dag).Font.ColorIndex = 1
.Cells(4, StartPos + Dag).Interior.ColorIndex = 35
End With
End If
WeekdagNaam = WeekdayName(Weekday(Datum), True, vbSunday)
With Sheets(Werkblad(Maand))
.Cells(2, StartPos + Dag).Value = ?
.Cells(3, StartPos + Dag).Value = Format(Datum, "dddd")
.Cells(4, StartPos + Dag).Value = CDate(Datum)
.Cells(21, StartPos + Dag).Value = Format(Date, "ww")
.Cells(22, StartPos + Dag).Value = Format(Datum, "dddd")
End With
End Select

Select Case Ploeg
Case 1
With Sheets(Werkblad(Maand))
.Cells(5, StartPos + Dag).Interior.ColorIndex = 41
End With
Case 2
With Sheets(Werkblad(Maand))
.Cells(5, StartPos + Dag).Interior.ColorIndex = 3
End With
Case 3
With Sheets(Werkblad(Maand))
.Cells(5, StartPos + Dag).Interior.ColorIndex = 6
End With
Case 4
With Sheets(Werkblad(Maand))
.Cells(5, StartPos + Dag).Interior.ColorIndex = 35
End With
Case 5
With Sheets(Werkblad(Maand))
.Cells(5, StartPos + Dag).Interior.ColorIndex = 2
End With
End Select

With Sheets(Werkblad(Maand))
.Cells(5, StartPos + Dag).Font.Bold = False
.Cells(5, StartPos + Dag).Font.Underline = xlUnderlineStyleNone
.Cells(5, StartPos + Dag).Value = Empty
End With

CDN5Pld = (Jaar - 1900) * 366 + Dagen5Pld(Maand) + Dag

If Datum >= #9/1/2006# Then
Ochtend = 5 - (((CDN5Pld) Mod 10) \ 2)
Middag = 5 - (((CDN5Pld - 2) Mod 10) \ 2)
Nacht = 5 - (((CDN5Pld - 5) Mod 10) \ 2)
Else
Ochtend = 5 - (((CDN5Pld - 12) Mod 15) \ 3)
Middag = 5 - (((CDN5Pld - 7) Mod 15) \ 3)
Nacht = 5 - (((CDN5Pld - 2) Mod 15) \ 3)
End If

If Ploeg = Ochtend Then Sheets(Werkblad(Maand)).Cells(5, StartPos + Dag).Value = "Ochtend"
If Ploeg = Middag Then Sheets(Werkblad(Maand)).Cells(5, StartPos + Dag).Value = "Middag"
If Ploeg = Nacht Then Sheets(Werkblad(Maand)).Cells(5, StartPos + Dag).Value = "Nacht"

Next Dag
If Datum < #3/1/2006# And Not Schrikkeljaar And Maand = 2 Then
With Sheets(Werkblad(Maand))
If .Cells(5, StartPos + 22).Value = "Ochtend" And .Cells(5, StartPos + 23).Value = "" _
Then .Cells(5, StartPos + 27).Value = ""
If .Cells(5, StartPos + 23).Value = "Ochtend" And .Cells(5, StartPos + 24).Value = "" _
Then .Cells(5, StartPos + 28).Value = ""
If .Cells(5, StartPos + 25).Value = "Ochtend" And .Cells(5, StartPos + 26).Value = "" _
Then .Cells(5, StartPos + 27).Value = "Nacht"
End With
End If

If Not Schrikkeljaar And Maand = 2 Then
With Sheets(Werkblad(Maand))
.Cells(3, StartPos + 29).Value = Empty
.Cells(4, StartPos + 29).Value = Empty
.Cells(5, StartPos + 29).Value = Empty
.Cells(3, StartPos + 29).Font.Bold = False
.Cells(3, StartPos + 29).Font.Underline = xlUnderlineStyleNone
.Cells(3, StartPos + 29).Font.ColorIndex = 1
.Cells(3, StartPos + 29).Interior.ColorIndex = xlNone
.Cells(4, StartPos + 29).Font.Bold = False
.Cells(4, StartPos + 29).Font.Underline = xlUnderlineStyleNone
.Cells(4, StartPos + 29).Font.ColorIndex = 1
.Cells(4, StartPos + 29).Interior.ColorIndex = xlNone
.Cells(5, StartPos + 29).Font.Bold = False
.Cells(5, StartPos + 29).Font.Underline = xlUnderlineStyleNone
.Cells(5, StartPos + 29).Font.ColorIndex = 1
.Cells(5, StartPos + 29).Interior.ColorIndex = xlNone
End With
End If
Next Maand
Application.ScreenUpdating = True
End Sub

Private Function Paasdag(Jaar)
Dim c, G, H, i, J, L, PMaand, PDag As Integer

G = Jaar Mod 19

c = Jaar \ 100
H = (c - c \ 4 - (8 * c + 13) \ 25 + 19 * G + 15) Mod 30
i = H - (H \ 28) * (1 - (29 \ (H + 1)) * ((21 - G) \ 11))
J = (Jaar + Jaar \ 4 + i + 2 - c + c \ 4) Mod 7

L = i - J

PMaand = 3 + (L + 40) \ 44
PDag = L + 28 - 31 * (PMaand \ 4)
Paasdag = DateSerial(Jaar, PMaand, PDag)

End Function
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
Sort by date Sort by votes
You must log in or register to reply here.

Similar threads

A
  • Solved
Error with working days in a month
Replies
5
Views
503
Anthony47
A
littlepete
  • Question Question
UDF tells age - now asking the same for deceased person
Replies
3
Views
580
johnnyL
J
Emka
  • Question Question
Web Scrap on Chrome via VBA
Replies
0
Views
140
Emka
Emka
R
  • Solved
Macro To Move Files - Will Not Move .msg or .csv files
Replies
4
Views
105
rachel06
R
S
  • Question Question
Multiple columns lookup
Replies
0
Views
284
Sipirili2504
S

Forum statistics

Threads
1,224,587
Messages
6,179,733
Members
452,939
Latest member
WCrawford

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top