Build a custom form adding all the conrols at vba Runtime that will become the Excel Calendar Tool (TaskMaster)
Step by Step Instructions
- Create a new “Blank” workbook called Basic Calendar (make sure it is an .xlsm or xlsb type)
- go to the VBE and add a new form
- Name the form frmCalendar
- match the Propeties of the form to :
Double click the form and add the follwing code to an intialize event:
Dim frmArray() As New CalendarClass
Private Sub UserForm_Initialize()
' Counters & misc variables ...
Dim i As Integer, X As Integer, j As Integer
Dim FrameCounter As Long
Dim sMisc As String
' objects to be added ...
Dim theframe As Object
' dates...
Dim dtStartofMnth As Date, dtCalMnthStart As Date
Dim dtEndofMnth As Date
' center a form on the spreadsheet
With Me
.Left = Application.Left + (0.5 * Application.Width)
.Top = Application.Top + (0.5 * Application.Height)
.Caption = "My Calendar"
End With
' set the height
Me.Height = 240
Me.Width = 225
'*************************************************************
' add the frames
'*************************************************************
j = 0: X = 0
For i = 1 To 42
sMisc = "frm" & i
Set theframe = Me.Controls.Add("Forms.Frame.1", "Test")
With theframe
.Font.Name = "Tahoma"
.ForeColor = &H8000000B
.BorderStyle = 1
.BackColor = &H0&
.BorderColor = &H0&
.Height = 28 ' constant ...
.Width = 28 ' |
.Left = 12 + (X * 28) ' varies
.Top = 52 + (j * 28) ' |
.Name = sMisc ' |
End With
X = X + 1
'for CalendarClass
ReDim Preserve frmArray(1 To i)
Set frmArray(i).frmEvents = theframe
' control top ...
Select Case i
Case 7, 14, 21, 28, 35, 42
j = j + 1
Case Else
End Select
' control top ...
Select Case i
Case 7, 14, 21, 28, 35, 42
X = 0
Case Else
End Select
Next i
' Populate the days ...
' month start...
sMisc = Month(Now()) & "/1/" & Year(Now)
dtStartofMnth = DateValue(sMisc)
dtEndofMnth = DateAdd("D", 41, dtStartofMnth)
j = Weekday(dtStartofMnth)
Select Case j
Case 1
dtCalMnthStart = dtStartofMnth - 6
Case 2
dtCalMnthStart = dtStartofMnth
Case 3
dtCalMnthStart = dtStartofMnth - 1
Case 4
dtCalMnthStart = dtStartofMnth - 2
Case 5
dtCalMnthStart = dtStartofMnth - 3
Case 6
dtCalMnthStart = dtStartofMnth - 4
Case 7
dtCalMnthStart = dtStartofMnth - 5
Case Else
End Select
For i = 1 To 42
sMisc = "frm" & i
Controls(sMisc).Caption = Day(dtCalMnthStart + (i - 1))
' set the day color if current month or not ...
' and background if today
If Month(dtCalMnthStart + (i - 1)) = Month(Now()) And Day(dtCalMnthStart + (i - 1)) = Day(Now()) Then
Controls(sMisc).BackColor = &H404040
Controls(sMisc).BorderColor = &H404040
Controls(sMisc).ForeColor = &H8000000B
' background this month ...
ElseIf Month(dtCalMnthStart + (i - 1)) = Month(Now()) Then
Controls(sMisc).ForeColor = &H8000000B
Controls(sMisc).BackColor = &H0&
Controls(sMisc).BorderColor = &H0&
' backgroun not this month...
Else
Controls(sMisc).ForeColor = &H80000011
Controls(sMisc).BackColor = &H0&
Controls(sMisc).BorderColor = &H0&
End If
Next i
End Sub
Ok now all youll need is to all insert a class module and name it Calendarclass. Insert the code below into your calendar
class module
you can run your form from the immediate window by typing
formCalendar.show
If you did it right it should look like the image to the left. This is step one to building you own Excel Calendar tool (TaskMaster)
Public WithEvents frmEvents As MSForms.Frame
Private Sub frmEvents_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Dim sMisc As String 'Misc string holder
Dim sCaller As String 'Frm hovered over
Dim i As Integer 'counter
Dim iFRM As Integer 'cal box numver
Dim iDate As Integer 'day of month
Dim iMnth As Integer 'the month
Dim iYear As Integer 'the Year
Dim dtMnthStart 'start of the month shown
Dim myvar As Variant 'variant for spliting
' capture the caller...
sCaller = frmEvents.Name
' calculate the date ....
iFRM = Val(Replace(sCaller, "frm", ""))
iDate = Val(frmCalendar.Controls(sCaller).Caption)
If iFRM < 7 And iDate > 20 Then
iMnth = Month(DateAdd("m", -1, dtMnthStart))
iYear = Year(DateAdd("m", -1, dtMnthStart))
ElseIf iFRM > 35 And iDate < 7 Then
iMnth = Month(DateAdd("m", 1, dtMnthStart))
iYear = Year(DateAdd("m", 1, dtMnthStart))
Else
iMnth = Month(dtMnthStart)
iYear = Year(dtMnthStart)
End If
' account for Monday 1st day of week ....
mydate = DateValue(iMnth & "/" & iDate & "/" & iYear)
frmCalendar.Controls("lblWeekDay").Caption = MonthName(Month(mydate)) & ", " & WeekdayName(Weekday(mydate)) & " " & Day(mydate)
' control the highlighting ...
For i = 1 To 42
sMisc = "frm" & i
If sCaller = sMisc Then
' highlight the cell pointed to ...
frmCalendar.Controls(frmEvents.Name).BackColor = &H404040
frmCalendar.Controls(sMisc).BorderColor = &H404040
Else
' return the cell to black...
If Day(Now) = Val(frmCalendar.Controls(sMisc).Caption) And frmCalendar.Controls(sMisc).ForeColor = &H8000000B Then
' today ...
Else
' not today not pointed to ...
frmCalendar.Controls(sMisc).BackColor = &H0&
frmCalendar.Controls(sMisc).BorderColor = &H0&
End If
End If
Next i
End Sub
if you need help with you next Excel project using VBA or would like a custom calendar developed contact me Here
If you would like to say hello and buy me a cup of coffee Click here.
