***Edit**: I don't know how to make it look like code in the forum, could someone either post a response with the two bits of code as code or do so from the link provided. thank you very much.
Hi, i have downloaded and successfully implemented the calender form that can be downloaded here :
http://allenbrowne.com/ser-51.html
However, as someone new to programming, I can't make SENSE of all the VBA and MACRO.
Would somebody please annotate it to show me what exactly is meant at each part please?
****Code also found below******
***i don't know how to display this in a better format, if anyone wants to post a reply with it formatted better that'd be greatly appreciated!
**this is the module**
Option Compare Database
Option Explicit
'Calendar form variable:
Public gtxtCalTarget As TextBox 'Text box to return the date from the calendar to.
Public Function CalendarFor(txt As TextBox, Optional strTitle As String)
'On Error GoTo Err_Handler
'Purpose: Open the calendar form, identifying the text box to return the date to.
'Arguments: txt = the text box to return the date to.
' strTitle = the caption for the calendar form (passed in OpenArgs).
Set gtxtCalTarget = txt
DoCmd.OpenForm "frmCalendar", windowmode:=acDialog, OpenArgs:=strTitle
Exit_Handler:
Exit Function
Err_Handler:
MsgBox "Error " & Err.Number & " - " & Err.Description, vbExclamation, "CalendarFor()"
Resume Exit_Handler
End Function
Public Function LogError(lngErr As Long, strDescrip As String, strProc As String, _
Optional bShowUser As Boolean = True, Optional varParam As Variant)
'Purpose: Minimal substitute for the real error logger function at:
' http://allenbrowne.com/ser-23a.html
If bShowUser Then
MsgBox "Error " & lngErr & ": " & strDescrip, vbExclamation, strProc
End If
End Function
***this is the code on the form***
'Copyright: Allen Browne's Database And Training, 2007.
'Author: Allen Browne. allen@allenbrowne.com
Option Compare Database
Option Explicit
Private Const conMod = "frmCalendar"
Private Sub cmdCancel_Click()
On Error GoTo Err_Handler
'Purpose: Close without transferring date back to calling text box.
DoCmd.Close acForm, Me.Name, acSaveNo
Exit_Handler:
Exit Sub
Err_Handler:
Call LogError(Err.Number, Err.Description, conMod & ".cmdCancel_Click")
Resume Exit_Handler
End Sub
Private Sub cmdMonthDown_Click()
Call SetDate("M", -1)
End Sub
Private Sub cmdMonthUp_Click()
Call SetDate("M", 1)
End Sub
Private Sub cmdOk_Click()
On Error Resume Next
'Purpose: Transfer the result back to the calling text box (if there is one), and close.
If Me.cmdOk.Enabled Then
If gtxtCalTarget = Me.txtDate Then
'do nothing
Else
gtxtCalTarget = Me.txtDate
End If
End If
gtxtCalTarget.SetFocus
DoCmd.Close acForm, Me.Name, acSaveNo
End Sub
Private Sub cmdToday_Click()
'On Error GoTo Err_Handler
'Purpose: Set today.
Me.txtDate = Date
Call ShowCal
Exit_Handler:
Exit Sub
Err_Handler:
Call LogError(Err.Number, Err.Description, conMod & ".cmdToday_Click")
Resume Exit_Handler
End Sub
Private Sub cmdYearDown_Click()
Call SetDate("YYYY", -1)
End Sub
Private Sub cmdYearUp_Click()
Call SetDate("YYYY", 1)
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'On Error GoTo Err_Handler
'Purpose:
With Me.txtDate
Select Case KeyCode
Case vbKeyLeft '1 day left or right.
.Value = .Value - 1
KeyCode = 0
Call ShowCal
Case vbKeyRight
.Value = .Value + 1
KeyCode = 0
Call ShowCal
Case vbKeyUp '1 week up or down.
.Value = .Value - 7
KeyCode = 0
Call ShowCal
Case vbKeyDown
.Value = .Value + 7
KeyCode = 0
Call ShowCal
Case vbKeyHome 'Home/End = first/last of this month.
.Value = .Value - Day(.Value) + 1
KeyCode = 0
Call ShowCal
Case vbKeyEnd
.Value = DateSerial(Year(.Value), Month(.Value) + 1, 0)
KeyCode = 0
Call ShowCal
Case vbKeyPageUp 'PgUp/PgDn = previous/next month.
.Value = DateAdd("m", -1, .Value)
KeyCode = 0
Call ShowCal
Case vbKeyPageDown
.Value = DateAdd("m", 1, .Value)
KeyCode = 0
Call ShowCal
Case vbKeyT, vbKeyT + 32 'T or t = today
.Value = Date
KeyCode = 0
Call ShowCal
End Select
End With
Exit_Handler:
Exit Sub
Err_Handler:
Call LogError(Err.Number, Err.Description, conMod & ".Form_KeyDown")
Resume Exit_Handler
End Sub
Private Sub Form_Open(Cancel As Integer)
'On Error GoTo Form_Open_Err
Dim bEnabled As Boolean
'Initialize to the existing date, or today if null.
If IsDate(gtxtCalTarget) Then
Me.txtDate = gtxtCalTarget.Value
Else
Me.txtDate = Date
End If
'Lock the Ok button if the text box is locked or disabled.
bEnabled = (gtxtCalTarget.Enabled) And (Not gtxtCalTarget.Locked)
With Me.cmdOk
If .Enabled <> bEnabled Then
.Enabled = bEnabled
End If
End With
'Set the title
If Len(Me.OpenArgs) > 0& Then
Me.Caption = Me.OpenArgs
End If
'Set up the calendar for this month.
Call ShowCal
Form_Open_Exit:
Exit Sub
Form_Open_Err:
MsgBox Err.Description, vbCritical, "frmCalendar.Form_Open"
Resume Form_Open_Exit
End Sub
Private Function SetSelected(ctlName As String)
On Error GoTo Err_Handler
Me.txtDate = DateSerial(Year(txtDate), Month(txtDate), CLng(Me(ctlName).Caption))
Call ShowHighligher(ctlName)
Exit_Handler:
Exit Function
Err_Handler:
Call LogError(Err.Number, Err.Description, conMod & ".SetSelected")
Resume Exit_Handler
End Function
Private Function SelectDate(ctlName As String)
Call SetSelected(ctlName)
Call cmdOk_Click
End Function
Private Function SetDate(Subject As String, Optional intStep As Integer = 1)
On Error GoTo Err_Handler
Me.txtDate = DateAdd(Subject, intStep, Me.txtDate)
Call ShowCal
Exit_Handler:
Exit Function
Err_Handler:
Call LogError(Err.Number, Err.Description, conMod & ".SetDate")
Resume Exit_Handler
End Function
Private Function ShowCal() As Boolean
On Error GoTo Err_Handler
'Purpose:
Dim dtStartDate As Date 'First of month
Dim iDays As Integer 'Days in month
Dim iOffset As Integer 'Offset to first label for month.
Dim i As Integer 'Loop controller.
Dim iDay As Integer 'Day under consideration.
Dim bShow As Boolean 'Flag: show label
dtStartDate = Me.txtDate - Day(Me.txtDate) + 1 'First of month
iDays = Day(DateAdd("m", 1, dtStartDate) - 1) 'Days in month.
iOffset = Weekday(dtStartDate, vbSunday) - 2 'Offset to first label for month.
For i = 0 To 41
With Me("lblDay" & Format(i, "00"))
iDay = i - iOffset
bShow = ((iDay > 0) And (iDay <= iDays))
If .Visible <> bShow Then
.Visible = bShow
End If
If (bShow) And (.Caption <> iDay) Then
.Caption = iDay
End If
End With
Next
Call ShowHighligher("lblDay" & Format(Day(Me.txtDate) + iOffset, "00"))
Exit_Handler:
Exit Function
Err_Handler:
Call LogError(Err.Number, Err.Description, conMod & ".ShowCal")
Resume Exit_Handler
End Function
Private Function ShowHighligher(ctlName As String)
On Error GoTo Err_Handler
Const lngcVOffset As Long = -83
With Me(ctlName)
Me.lblHighlight.Left = .Left
Me.lblHighlight.Top = .Top + lngcVOffset
End With
Exit_Handler:
Exit Function
Err_Handler:
Call LogError(Err.Number, Err.Description, conMod & ".ShowHighligher")
Resume Exit_Handler
End Function
Private Sub lblHelp_Click()
MsgBox Me.lblHelp.ControlTipText, vbInformation, "Calendar help"
End Sub
Kindest regards and thank you so much however you can help
-feel free to explain it , or parts of it like you are explaining it to me like i'm 5 or very very stupid
Hi, i have downloaded and successfully implemented the calender form that can be downloaded here :
http://allenbrowne.com/ser-51.html
However, as someone new to programming, I can't make SENSE of all the VBA and MACRO.
Would somebody please annotate it to show me what exactly is meant at each part please?
****Code also found below******
***i don't know how to display this in a better format, if anyone wants to post a reply with it formatted better that'd be greatly appreciated!
**this is the module**
Option Compare Database
Option Explicit
'Calendar form variable:
Public gtxtCalTarget As TextBox 'Text box to return the date from the calendar to.
Public Function CalendarFor(txt As TextBox, Optional strTitle As String)
'On Error GoTo Err_Handler
'Purpose: Open the calendar form, identifying the text box to return the date to.
'Arguments: txt = the text box to return the date to.
' strTitle = the caption for the calendar form (passed in OpenArgs).
Set gtxtCalTarget = txt
DoCmd.OpenForm "frmCalendar", windowmode:=acDialog, OpenArgs:=strTitle
Exit_Handler:
Exit Function
Err_Handler:
MsgBox "Error " & Err.Number & " - " & Err.Description, vbExclamation, "CalendarFor()"
Resume Exit_Handler
End Function
Public Function LogError(lngErr As Long, strDescrip As String, strProc As String, _
Optional bShowUser As Boolean = True, Optional varParam As Variant)
'Purpose: Minimal substitute for the real error logger function at:
' http://allenbrowne.com/ser-23a.html
If bShowUser Then
MsgBox "Error " & lngErr & ": " & strDescrip, vbExclamation, strProc
End If
End Function
***this is the code on the form***
'Copyright: Allen Browne's Database And Training, 2007.
'Author: Allen Browne. allen@allenbrowne.com
Option Compare Database
Option Explicit
Private Const conMod = "frmCalendar"
Private Sub cmdCancel_Click()
On Error GoTo Err_Handler
'Purpose: Close without transferring date back to calling text box.
DoCmd.Close acForm, Me.Name, acSaveNo
Exit_Handler:
Exit Sub
Err_Handler:
Call LogError(Err.Number, Err.Description, conMod & ".cmdCancel_Click")
Resume Exit_Handler
End Sub
Private Sub cmdMonthDown_Click()
Call SetDate("M", -1)
End Sub
Private Sub cmdMonthUp_Click()
Call SetDate("M", 1)
End Sub
Private Sub cmdOk_Click()
On Error Resume Next
'Purpose: Transfer the result back to the calling text box (if there is one), and close.
If Me.cmdOk.Enabled Then
If gtxtCalTarget = Me.txtDate Then
'do nothing
Else
gtxtCalTarget = Me.txtDate
End If
End If
gtxtCalTarget.SetFocus
DoCmd.Close acForm, Me.Name, acSaveNo
End Sub
Private Sub cmdToday_Click()
'On Error GoTo Err_Handler
'Purpose: Set today.
Me.txtDate = Date
Call ShowCal
Exit_Handler:
Exit Sub
Err_Handler:
Call LogError(Err.Number, Err.Description, conMod & ".cmdToday_Click")
Resume Exit_Handler
End Sub
Private Sub cmdYearDown_Click()
Call SetDate("YYYY", -1)
End Sub
Private Sub cmdYearUp_Click()
Call SetDate("YYYY", 1)
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'On Error GoTo Err_Handler
'Purpose:
With Me.txtDate
Select Case KeyCode
Case vbKeyLeft '1 day left or right.
.Value = .Value - 1
KeyCode = 0
Call ShowCal
Case vbKeyRight
.Value = .Value + 1
KeyCode = 0
Call ShowCal
Case vbKeyUp '1 week up or down.
.Value = .Value - 7
KeyCode = 0
Call ShowCal
Case vbKeyDown
.Value = .Value + 7
KeyCode = 0
Call ShowCal
Case vbKeyHome 'Home/End = first/last of this month.
.Value = .Value - Day(.Value) + 1
KeyCode = 0
Call ShowCal
Case vbKeyEnd
.Value = DateSerial(Year(.Value), Month(.Value) + 1, 0)
KeyCode = 0
Call ShowCal
Case vbKeyPageUp 'PgUp/PgDn = previous/next month.
.Value = DateAdd("m", -1, .Value)
KeyCode = 0
Call ShowCal
Case vbKeyPageDown
.Value = DateAdd("m", 1, .Value)
KeyCode = 0
Call ShowCal
Case vbKeyT, vbKeyT + 32 'T or t = today
.Value = Date
KeyCode = 0
Call ShowCal
End Select
End With
Exit_Handler:
Exit Sub
Err_Handler:
Call LogError(Err.Number, Err.Description, conMod & ".Form_KeyDown")
Resume Exit_Handler
End Sub
Private Sub Form_Open(Cancel As Integer)
'On Error GoTo Form_Open_Err
Dim bEnabled As Boolean
'Initialize to the existing date, or today if null.
If IsDate(gtxtCalTarget) Then
Me.txtDate = gtxtCalTarget.Value
Else
Me.txtDate = Date
End If
'Lock the Ok button if the text box is locked or disabled.
bEnabled = (gtxtCalTarget.Enabled) And (Not gtxtCalTarget.Locked)
With Me.cmdOk
If .Enabled <> bEnabled Then
.Enabled = bEnabled
End If
End With
'Set the title
If Len(Me.OpenArgs) > 0& Then
Me.Caption = Me.OpenArgs
End If
'Set up the calendar for this month.
Call ShowCal
Form_Open_Exit:
Exit Sub
Form_Open_Err:
MsgBox Err.Description, vbCritical, "frmCalendar.Form_Open"
Resume Form_Open_Exit
End Sub
Private Function SetSelected(ctlName As String)
On Error GoTo Err_Handler
Me.txtDate = DateSerial(Year(txtDate), Month(txtDate), CLng(Me(ctlName).Caption))
Call ShowHighligher(ctlName)
Exit_Handler:
Exit Function
Err_Handler:
Call LogError(Err.Number, Err.Description, conMod & ".SetSelected")
Resume Exit_Handler
End Function
Private Function SelectDate(ctlName As String)
Call SetSelected(ctlName)
Call cmdOk_Click
End Function
Private Function SetDate(Subject As String, Optional intStep As Integer = 1)
On Error GoTo Err_Handler
Me.txtDate = DateAdd(Subject, intStep, Me.txtDate)
Call ShowCal
Exit_Handler:
Exit Function
Err_Handler:
Call LogError(Err.Number, Err.Description, conMod & ".SetDate")
Resume Exit_Handler
End Function
Private Function ShowCal() As Boolean
On Error GoTo Err_Handler
'Purpose:
Dim dtStartDate As Date 'First of month
Dim iDays As Integer 'Days in month
Dim iOffset As Integer 'Offset to first label for month.
Dim i As Integer 'Loop controller.
Dim iDay As Integer 'Day under consideration.
Dim bShow As Boolean 'Flag: show label
dtStartDate = Me.txtDate - Day(Me.txtDate) + 1 'First of month
iDays = Day(DateAdd("m", 1, dtStartDate) - 1) 'Days in month.
iOffset = Weekday(dtStartDate, vbSunday) - 2 'Offset to first label for month.
For i = 0 To 41
With Me("lblDay" & Format(i, "00"))
iDay = i - iOffset
bShow = ((iDay > 0) And (iDay <= iDays))
If .Visible <> bShow Then
.Visible = bShow
End If
If (bShow) And (.Caption <> iDay) Then
.Caption = iDay
End If
End With
Next
Call ShowHighligher("lblDay" & Format(Day(Me.txtDate) + iOffset, "00"))
Exit_Handler:
Exit Function
Err_Handler:
Call LogError(Err.Number, Err.Description, conMod & ".ShowCal")
Resume Exit_Handler
End Function
Private Function ShowHighligher(ctlName As String)
On Error GoTo Err_Handler
Const lngcVOffset As Long = -83
With Me(ctlName)
Me.lblHighlight.Left = .Left
Me.lblHighlight.Top = .Top + lngcVOffset
End With
Exit_Handler:
Exit Function
Err_Handler:
Call LogError(Err.Number, Err.Description, conMod & ".ShowHighligher")
Resume Exit_Handler
End Function
Private Sub lblHelp_Click()
MsgBox Me.lblHelp.ControlTipText, vbInformation, "Calendar help"
End Sub
Kindest regards and thank you so much however you can help
-feel free to explain it , or parts of it like you are explaining it to me like i'm 5 or very very stupid
