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