VBA — Cambodia Khmer Calendar 2026
Option Explicit
Sub Create_8AM_Khmer_Calendar_2026()
Dim calName As String
Dim cal As Calendar
calName = "8AM Cambodia Khmer Construction Calendar 2026"
On Error Resume Next
Application.BaseCalendarCreate Name:=calName, FromName:="Standard"
Set cal = ActiveProject.BaseCalendars(calName)
On Error GoTo 0
If cal Is Nothing Then
MsgBox "Cannot create calendar. Please create manually first.", vbCritical
Exit Sub
End If
ClearOldExceptions cal
SetWorkDay cal, pjMonday
SetWorkDay cal, pjTuesday
SetWorkDay cal, pjWednesday
SetWorkDay cal, pjThursday
SetWorkDay cal, pjFriday
SetWorkDay cal, pjSaturday
cal.WeekDays(pjSunday).Working = False
AddHoliday cal, "International New Year Day", #1/1/2026#, #1/1/2026#
AddHoliday cal, "Victory over Genocide Day", #1/7/2026#, #1/7/2026#
AddHoliday cal, "International Women's Day", #3/8/2026#, #3/8/2026#
AddHoliday cal, "Khmer New Year", #4/14/2026#, #4/16/2026#
AddHoliday cal, "Labor Day / Visak Bochea", #5/1/2026#, #5/1/2026#
AddHoliday cal, "Royal Plowing Ceremony", #5/5/2026#, #5/5/2026#
AddHoliday cal, "King's Birthday", #5/14/2026#, #5/14/2026#
AddHoliday cal, "Queen Mother's Birthday", #6/18/2026#, #6/18/2026#
AddHoliday cal, "Constitution Day", #9/24/2026#, #9/24/2026#
AddHoliday cal, "Pchum Ben Festival", #10/10/2026#, #10/12/2026#
AddHoliday cal, "King Father Commemoration Day", #10/15/2026#, #10/15/2026#
AddHoliday cal, "King's Coronation Day", #10/29/2026#, #10/29/2026#
AddHoliday cal, "Independence Day", #11/9/2026#, #11/9/2026#
AddHoliday cal, "Water Festival", #11/23/2026#, #11/25/2026#
AddHoliday cal, "Peace Day in Cambodia", #12/29/2026#, #12/29/2026#
MsgBox "Done! Calendar updated successfully.", vbInformation
End Sub
Sub ClearOldExceptions(ByVal cal As Calendar)
Dim i As Long
On Error Resume Next
For i = cal.Exceptions.Count To 1 Step -1
cal.Exceptions(i).Delete
Next i
On Error GoTo 0
End Sub
Sub SetWorkDay(ByVal cal As Calendar, ByVal dayNumber As Long)
With cal.WeekDays(dayNumber)
.Working = True
.Shift1.Start = TimeValue("7:00 AM")
.Shift1.Finish = TimeValue("11:00 AM")
.Shift2.Start = TimeValue("1:00 PM")
.Shift2.Finish = TimeValue("5:00 PM")
End With
End Sub
Sub AddHoliday(ByVal cal As Calendar, ByVal hName As String, ByVal dStart As Date, ByVal dFinish As Date)
Dim ex As Exception
On Error Resume Next
Set ex = cal.Exceptions.Add(Type:=pjDaily, Start:=dStart, Finish:=dFinish)
If Not ex Is Nothing Then
ex.Name = hName
ex.Working = False
End If
On Error GoTo 0
End Sub