Calendar using dynamic form

Public Function Getdate() As Variant
' edit to get what ever return you want
Dim stFRmName As String
stFRmName = CreateCalForm
Do Until IsDate(Forms(stFRmName).Tag) ' check to see if date selected
DoEvents
Loop
Getdate = Forms(stFRmName).Tag
DoCmd.CLOSE acForm, stFRmName, acSaveNo
End Function
Public Function CreateCalForm() As String
Dim frm As Form
'creates form
Set frm = CreateForm
With frm 'set any additional form properties you need here
.Caption = "POP UP Calender"
.RecordSelectors = False
.NavigationButtons = False
.Width = 2.5
.Section(acDetail).Height = 3
CreateCalForm = .name
End With
Call LoadControls(frm)
End Function

Public Function LoadControls(ByVal frm As Form)
Dim txt(42) As Control, ctlMonth As Control
Dim ctlYear As Control
Dim txtLeft As Integer, TxtTop As Integer
Dim xPos As Integer, yPos As Integer, X As Integer
Dim TxtHeight As Integer, TxtWidth As Integer
Dim stFRmNam As String
stFRmNam = frm.name
'Adjust to size boxes. Could base on size of form
TxtHeight = 400
TxtWidth = 400
TxtTop = 400
txtLeft = 5
'creates 6x7 grid of text boxes
For yPos = 1 To 6
For xPos = 1 To 7
Set txt(X) = CreateControl(stFRmNam, acTextBox, , "", "", txtLeft, TxtTop, TxtWidth, TxtHeight)
txtLeft = txtLeft + TxtWidth 'sets with of text boxes
'set any additional properties or events here
txt(X).OnClick = "=Clicked()" 'add on click event to each box
txt(X).name = "d" & X + 1 'name boxes like an array
X = X + 1
Next xPos 'next box
txtLeft = 5 'go back to left start position
TxtTop = TxtTop + TxtHeight 'drop down height
Next yPos  'next row
'create additional txtboxes to hold Month & year
Set ctlMonth = CreateControl(stFRmNam, acTextBox, , "", "", 100, 10, 1000, 300)
ctlMonth.name = "txMonth"
Set ctlYear = CreateControl(stFRmNam, acTextBox, , "", "", 1100, 10, 1000, 300)
ctlYear.name = "txYear"
' load module to load dates and open form
Call LoadModule(frm)
DoCmd.OpenForm stFRmNam
End Function
Public Function LoadModule(ByVal frm As Form)
 Dim Mdl As Module
 Dim stBld As String
'creates module
Set Mdl = frm.Module
'creates eventprocedures This is ugly to save space. You can see it better
'Once form is created click on design view
stBld = stBld & "Private Function LoadCal(dtMonth as integer, dtyear as integer)" & vbCrLf
stBld = stBld & "Dim Curday as Variant, dtFirst as variant" & vbCrLf
stBld = stBld & "curday = DateSerial(dtyear, dtmonth, 1)" & vbCrLf
stBld = stBld & "dtFirst = curday" & vbCrLf
stBld = stBld & "me![txMonth] = Format(dtFirst, ""m"")" & vbCrLf
stBld = stBld & "me![txYear] = Format(dtFirst, ""YYYY"")" & vbCrLf
stBld = stBld & "Do Until curday = DateSerial(dtyear, dtmonth + 1, 1)" & vbCrLf
stBld = stBld & "me(""D"" & Day(curday) + WeekDay(dtFirst) - 1) = Day(curday)" & vbCrLf
stBld = stBld & vbCrLf & "curday = DateAdd(""d"", 1, curday)" & vbCrLf & "Loop" & vbCrLf
stBld = stBld & "End Function" & vbCrLf
stBld = stBld & "Private Sub Form_Load()" & vbCrLf
stBld = stBld & "DoCmd.RunCommand (acCmdSizeToFitForm)" & vbCrLf
stBld = stBld & "Call LoadCal(Month(date),Year(date))" & vbCrLf & " End Sub" & vbCrLf
stBld = stBld & "Public Function Clicked()" & vbCrLf
stBld = stBld & "me.tag = txmonth & ""/"" & me.activecontrol.value & ""/"" & txYear" & vbCrLf & "End Function"
stBld = stBld & vbCrLf & "Private Sub txMonth_AfterUpdate()" & vbCrLf
stBld = stBld & "call ClearCal()" & vbCrLf & "call LoadCal(me!txmonth, me!txYear)" & vbCrLf
stBld = stBld & "End Sub" & vbCrLf
stBld = stBld & "Private Sub txYear_AfterUpdate()" & vbCrLf
stBld = stBld & "call ClearCal()" & vbCrLf & "call LoadCal(me!txmonth, me!txYear)" & vbCrLf
stBld = stBld & "End Sub" & vbCrLf
stBld = stBld & "Private Sub ClearCal()" & vbCrLf
stBld = stBld & "Dim X as integer" & vbCrLf & "for x = 1 to 42" & vbCrLf
stBld = stBld & "me(""D"" & x) = """ & vbCrLf
stBld = stBld & "next x" & vbCrLf & "End Sub"
'can also use ( insertlines addfromfile addfromstring) in place of inserttext
Mdl.InsertText stBld
End Function