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

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
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
256
Anthony47
A
littlepete
  • Question
UDF tells age - now asking the same for deceased person
Replies
3
Views
418
johnnyL
J
Romano_odK
  • Solved
End the VBA from running
Replies
6
Views
515
Fluff
Fluff
J
  • Question
Combining VBA code together...need help!
Replies
3
Views
190
Fluff
Fluff
R
  • Question
Macro not working after adding two new items
Replies
4
Views
134
myall_blues
myall_blues

Forum statistics

Threads
1,215,364
Messages
6,124,510
Members
449,166
Latest member
hokjock

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