You can also set the RowSourceType property with a user-defined function. The function name is entered without a preceding equal sign (=) and without the trailing pair of parentheses. You must provide specific function code arguments to tell Access how to fill the control.However, they both contain a link to a page with useful information:
Public Function ListMondays( _
ByRef ctl As Control, _
ByVal Id As Long, _
ByVal Row As Long,
Byval Column As Long,
Byval Code As Integer) _
As Variant
Dim Offset As Integer
Dim WeekdayDate As Date
Select Case Code
Case acLBInitialize ' Initialize.
ListMondays = True
Case acLBOpen ' Open.
ListMondays = Timer ' Unique ID.
Case acLBGetRowCount ' Get rows.
ListMondays = 4
Case acLBGetColumnCount ' Get columns.
ListMondays = 1
Case acLBGetColumnWidth ' Get column width.
ListMondays = -1 ' Use default width.
Case acLBGetValue ' Get the data.
Offset = Abs((9 - Weekday(Date)) Mod 7)
WeekdayDate = DateAdd("d", Offset + 7 * row, Date)
ListMondays = Format(WeekdayDate, "mmmm d")
End Select
End Function
Monday |
---|
June 14 |
June 21 |
June 28 |
July 5 |
' Callback function to list the weekday names of a week.
' The selected value will be a value of enum VbDayOfWeek (Long).
' The displayed values will be those of WeekdayName(DayOfWeek, False, vbSunday).
'
' Example for retrieval of selected value:
'
' Dim DayOfWeek As VbDayOfWeek
' DayOfWeek = Me!ControlName.Value
'
' Typical settings for combobox or listbox:
'
' ControlSource: Bound or unbound
' RowSource: Leave empty
' RowSourceType: CallWeekdays
' BoundColumn: 1
' LimitToList: Yes
' AllowEditing: No
' Format: None
' ColumnCount: Don't care. Will be set by the function
' ColumnWidths: Don't care. Will be overridden by the function
'
' 2021-02-19. Cactus Data ApS, CPH.
'
Public Function CallWeekdays( _
ByRef Control As Control, _
ByVal Id As Long, _
ByVal Row As Long, _
ByVal Column As Variant, _
ByVal Code As Integer) _
As Variant
' Adjustable constants.
'
' Left margin of combobox to align the values on list with the formatted value displayed.
' Empiric value.
Const LeftMargin As Integer = 23
' Fixed constants.
'
' Count of rows to display.
Const RowCount As Long = DaysPerWeek
' Count of columns in the control.
Const ColumnCount As Long = 2
Static ColumnWidth(0 To ColumnCount - 1) As Integer
Static FirstDayOfWeek As VbDayOfWeek
Dim DayOfWeek As VbDayOfWeek
Dim Value As Variant
Select Case Code
Case acLBInitialize
' Control settings.
Control.ColumnCount = ColumnCount ' Set the colum count of the control.
ColumnWidth(0) = HiddenColumnWidth ' Hide the bound (value) column.
ColumnWidth(1) = DefaultColumnWidth ' Set the width of the display column to the default width.
If Control.ControlType = acComboBox Then
Control.LeftMargin = LeftMargin ' Adjust left margin of combobox.
End If
' Value settings.
FirstDayOfWeek = SystemDayOfWeek ' First day in the week as to the system settings.
' Initialize.
Value = True ' True to initialize.
Case acLBOpen
Value = Timer ' Autogenerated unique ID.
Case acLBGetRowCount ' Get count of rows.
Value = RowCount ' Set count of rows.
Case acLBGetColumnCount ' Get count of columns.
Value = ColumnCount ' Set count of columns.
Case acLBGetColumnWidth ' Get the column width.
Value = ColumnWidth(Column) ' Use preset column widths.
Case acLBGetValue ' Get the data for each row.
DayOfWeek = (FirstDayOfWeek + Row - 1) Mod DaysPerWeek + 1
If Column = 0 Then
' Return weekday value.
Value = DayOfWeek
Else
' Return friendly name for display.
Value = StrConv(WeekdayName(DayOfWeek, False, vbSunday), vbProperCase)
End If
Case acLBGetFormat ' Format the data.
' N/A ' Apply the value or the display format.
Case acLBClose ' Do something when the form recalculates or closes.
' no-op.
Case acLBEnd ' Do something more when the form recalculates or closes.
' no-op.
End Select
' Return Value.
CallWeekdays = Value
End Function
' Returns the weekday of the first day of the week according to the current Windows settings.
'
' 2017-05-03. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function SystemDayOfWeek() As VbDayOfWeek
Const DateOfSaturday As Date = #12:00:00 AM#
Dim DayOfWeek As VbDayOfWeek
DayOfWeek = vbSunday + vbSaturday - Weekday(DateOfSaturday, vbUseSystemDayOfWeek)
SystemDayOfWeek = DayOfWeek
End Function
' Callback function to list the weekday names of a week.
' The selected value will be the date of the weekday in the current week.
' The displayed values will be those of WeekdayName(DayOfWeek, False, vbSunday).
'
' Example for retrieval of selected value:
'
' Dim DateOfWeek As Date
' DateOfWeek = Me!ControlName.Value
'
' Typical settings for combobox or listbox:
'
' ControlSource: Bound or unbound
' RowSource: Leave empty
' RowSourceType: CallThisWeekDates
' BoundColumn: 1
' LimitToList: Yes
' AllowEditing: No
' Format: None
' ColumnCount: Don't care. Will be set by the function
' ColumnWidths: Don't care. Will be overridden by the function
'
' 2021-02-16. Cactus Data ApS, CPH.
'
Public Function CallThisWeekDates( _
ByRef Control As Control, _
ByVal Id As Long, _
ByVal Row As Long, _
ByVal Column As Variant, _
ByVal Code As Integer) _
As Variant
' Adjustable constants.
'
' Left margin of combobox to align the values on list with the formatted value displayed.
' Empiric value.
Const LeftMargin As Integer = 23
' Fixed constants.
'
' Count of rows to display.
Const RowCount As Long = DaysPerWeek
' Count of columns in the control.
Const ColumnCount As Integer = 2
Static ColumnWidth(0 To ColumnCount - 1) As Integer
Static FirstDateOfWeek As Date
Dim DateOfWeek As Date
Dim Value As Variant
Select Case Code
Case acLBInitialize
' Control settings.
Control.ColumnCount = ColumnCount ' Set the colum count of the control.
ColumnWidth(0) = HiddenColumnWidth ' Hide the bound (value) column.
ColumnWidth(1) = DefaultColumnWidth ' Set the width of the display column to the default width.
If Control.ControlType = acComboBox Then
Control.LeftMargin = LeftMargin ' Adjust left margin of combobox.
End If
' Value settings.
' First date of the week as to the system settings.
FirstDateOfWeek = DateThisWeekPrimo(Date, vbUseSystemDayOfWeek)
' Initialize.
Value = True ' True to initialize.
Case acLBOpen
Value = Timer ' Autogenerated unique ID.
Case acLBGetRowCount ' Get count of rows.
Value = RowCount ' Set count of rows.
Case acLBGetColumnCount ' Get count of columns.
Value = ColumnCount ' Set count of columns.
Case acLBGetColumnWidth ' Get the column width.
Value = ColumnWidth(Column) ' Use preset column widths.
Case acLBGetValue ' Get the data for each row.
DateOfWeek = DateAdd("d", Row, FirstDateOfWeek)
If Column = 0 Then
' Return date of weekday.
Value = DateOfWeek
Else
' Return friendly name for display.
Value = StrConv(Format(DateOfWeek, "dddd"), vbProperCase)
End If
Case acLBGetFormat ' Format the data.
' N/A ' Apply the value or the display format.
Case acLBClose ' Do something when the form recalculates or closes.
' no-op.
Case acLBEnd ' Do something more when the form recalculates or closes.
' no-op.
End Select
' Return Value.
CallThisWeekDates = Value
End Function
FirstDateOfWeek = DateAdd("d", 1 - Weekday(Date, vbUseSystemDayOfWeek), Date)
Private Sub ThisWeekDates_AfterUpdate()
Me!WeekdayDate.Value = Me!ThisWeekDates.Value
End Sub
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (1)
Commented:
Thanks for posting.
Joe