Results 1 to 9 of 9
  1. #1
    SierraJuliet's Avatar
    SierraJuliet is offline Competent Performer
    Windows 7 64bit Access 2013 64bit
    Join Date
    Dec 2017
    Location
    Earth
    Posts
    211

    Populate Calendar Form with Days of Week

    There is a form for a calendar. This form has 42 unbound text boxes.

    I need to know how to populate this form with the days of the week given a selected/current month and year?

    This calendar will eventually allow the user to enter tasks so each day of the month shows one or more tasks that are due for any given day. Essentially the calendar allows the user to visualize things such as appointments and so forth.

  2. #2
    isladogs's Avatar
    isladogs is offline MVP / VIP
    Windows 10 Access 2010 32bit
    Join Date
    Jan 2014
    Location
    Somerset, UK
    Posts
    5,954
    Have a look at this example database rather than reinvent the wheel http://www.mendipdatasystems.co.uk/b...ker/4594398118
    Colin, Access MVP, Website, email
    The more I learn, the more I know I don't know. When I don't know, I keep quiet!
    If I don't know that I don't know, I don't know whether to answer

  3. #3
    SierraJuliet's Avatar
    SierraJuliet is offline Competent Performer
    Windows 7 64bit Access 2013 64bit
    Join Date
    Dec 2017
    Location
    Earth
    Posts
    211
    Thanks. I updated my original post to better explain the calendar's function. I need more than a date picker.

  4. #4
    isladogs's Avatar
    isladogs is offline MVP / VIP
    Windows 10 Access 2010 32bit
    Join Date
    Jan 2014
    Location
    Somerset, UK
    Posts
    5,954
    That's more complex. I also have something like that to schedule events but its part of a commercial app.
    However Peter Hibbs has an excellent example at UA that you may like. See https://www.utteraccess.com/forum/in...78&hl=Calendar
    Its a very long thread with well over 200 replies
    Colin, Access MVP, Website, email
    The more I learn, the more I know I don't know. When I don't know, I keep quiet!
    If I don't know that I don't know, I don't know whether to answer

  5. #5
    moke123's Avatar
    moke123 is offline Me.Dirty=True
    Windows 7 32bit Access 2010 32bit
    Join Date
    Oct 2012
    Location
    Ma.
    Posts
    1,643
    heres a simple calendar.
    Attached Files Attached Files

  6. #6
    accesstos's Avatar
    accesstos is offline Expert
    Windows XP Access 2007
    Join Date
    Dec 2018
    Location
    Greece
    Posts
    551
    Hi all!

    Can't open moke's calendar.accdb, so forgive me if my attached sample is on the same approach.
    There is a form with 42 listboxes, one listbox for each day of six weeks. Οnce you doubleclick on a listbox, you can add/remove/edit appointments for the corresponding day.
    Attached Files Attached Files

  7. #7
    SierraJuliet's Avatar
    SierraJuliet is offline Competent Performer
    Windows 7 64bit Access 2013 64bit
    Join Date
    Dec 2017
    Location
    Earth
    Posts
    211
    Thanks all. I will get back to you with solution that works.

  8. #8
    SierraJuliet's Avatar
    SierraJuliet is offline Competent Performer
    Windows 7 64bit Access 2013 64bit
    Join Date
    Dec 2017
    Location
    Earth
    Posts
    211
    The following shows calendar and calendar data entry forms along with code for each. The calendar drop-down options are for admin and managers to add, edit, and or remove entries from an individual user within their purview, which may not be necessary for most people's requirements. The calendar has previous record and next record buttons that automatically change the month combo box and when transitioning between December and January the year textbox automatically increments forward or reverse depending on direction of record selection (i.e. previous or next).

    Click image for larger version. 

Name:	Capture.JPG 
Views:	52 
Size:	69.4 KB 
ID:	39597
    CALENDAR FORM CODE:
    Code:
    Option Compare Database
    Option Explicit
    
    
    Private intYear As Integer
    Private intMonth As Integer
    Private lngFirstDayOfMonth As Long
    Private intLastDayOfLastMonth As Integer
    Private intFirstWeekday As Integer
    Private intDaysInMonth As Integer
    Private strFormReference As String
    Private MyArray() As Variant
    
    
    Private Sub Form_Load()
    On Error GoTo ErrorHandler
        Dim Permission As String
        Dim Staff As String
        Dim CaseGroup As String
        Dim ManagerGroup As String
        Dim DepartmentGroup As String
        Permission = [Forms]![frmLogin]![txtPermissions]
        Staff = [Forms]![frmLogin]![txtStaffNumber]
        CaseGroup = [Forms]![frmLogin]![txtCaseGroup]
        ManagerGroup = [Forms]![frmLogin]![txtManagerGroup]
        DepartmentGroup = [Forms]![frmLogin]![txtDepartmentGroup]
        If Permission = "Admin" Then
            Me.Caption = "Admin - Calendar"
            Me![txtAssignedDeptGroupCalendar].Visible = True
            Me![txtAssignedMgrGroupCalendar].Visible = True
            Me![txtAssignedCaseGroupCalendar].Visible = True
            Me![txtAssignedStaffCalendar].Visible = True
            Me![txtSelectMonth] = Month(Date)
            Me![txtSelectYear] = Year(Date)
            Call Main
        ElseIf Permission = "Manager" Then
            Me.Caption = "Manager - Calendar"
            Me![txtAssignedDeptGroupCalendar].Visible = True
            Me![txtAssignedMgrGroupCalendar].Visible = True
            Me![txtAssignedCaseGroupCalendar].Visible = True
            Me![txtAssignedStaffCalendar].Visible = True
            Me![txtAssignedDeptGroupCalendar] = DepartmentGroup
            Me![txtAssignedMgrGroupCalendar] = ManagerGroup
            Me![txtSelectMonth] = Month(Date)
            Me![txtSelectYear] = Year(Date)
            Call Main
        ElseIf Permission = "User" Then
            Me.Caption = "Staff - Calendar"
            Me![txtAssignedDeptGroupCalendar].Visible = False
            Me![txtAssignedMgrGroupCalendar].Visible = False
            Me![txtAssignedCaseGroupCalendar].Visible = False
            Me![txtAssignedStaffCalendar].Visible = False
            Me![txtAssignedDeptGroupCalendar] = DepartmentGroup
            Me![txtAssignedMgrGroupCalendar] = ManagerGroup
            Me![txtAssignedCaseGroupCalendar] = CaseGroup
            Me![txtAssignedStaffCalendar] = Staff
            Me![txtSelectMonth] = Month(Date)
            Me![txtSelectYear] = Year(Date)
            Call Main
        ElseIf Permission = "HR" Then
            Me.Caption = "Human Resource - Calendar"
            Me![txtAssignedDeptGroupCalendar].Visible = True
            Me![txtAssignedMgrGroupCalendar].Visible = True
            Me![txtAssignedCaseGroupCalendar].Visible = True
            Me![txtAssignedStaffCalendar].Visible = True
            Me![txtAssignedDeptGroupCalendar] = DepartmentGroup
            Me![txtAssignedMgrGroupCalendar] = ManagerGroup
            Me![txtAssignedCaseGroupCalendar] = CaseGroup
            Me![txtAssignedStaffCalendar] = Staff
            Me![txtSelectMonth] = Month(Date)
            Me![txtSelectYear] = Year(Date)
            Call Main
        ElseIf Nz(Permission, "") = "" Or Nz(Permission, "") = 0 Then
            Beep
            modEventLog.Tracker "Unauthorized Calendar Access Attempt - Permissions Null or 0"
            DoCmd.Quit
        ElseIf Permission <> "Admin" Or Permission <> "Manager" Or Permission <> "User" Or Permission <> "HR" Then
            Beep
            modEventLog.Tracker "Unauthorized Calendar Access Attempt - Permissions Not Recognized"
            DoCmd.Quit
        End If
    ErrorHandler_Exit:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ErrorHandler_Exit
    End Sub
    
    
    Private Sub txtAssignedDeptGroupCalendar_GotFocus()
        Dim strSQL As String
        strSQL = "SELECT DepartmentGroupName FROM tlkpDepartmentGroup ORDER BY DepartmentGroupName ASC "
        Me![txtAssignedDeptGroupCalendar].RowSource = strSQL
        Me![txtAssignedDeptGroupCalendar].Requery
    End Sub
    
    
    Private Sub txtAssignedMgrGroupCalendar_GotFocus()
        Dim strSQL As String
        strSQL = "SELECT ManagerGroupName FROM tlkpManagerGroup ORDER BY ManagerGroupName ASC "
        Me![txtAssignedMgrGroupCalendar].RowSource = strSQL
        Me![txtAssignedMgrGroupCalendar].Requery
    End Sub
    
    
    Private Sub txtAssignedCaseGroupCalendar_GotFocus()
        Dim strSQL As String
        strSQL = "SELECT CaseGroupName FROM tlkpCaseGroup ORDER BY CaseGroupName ASC "
        Me![txtAssignedCaseGroupCalendar].RowSource = strSQL
        Me![txtAssignedCaseGroupCalendar].Requery
    End Sub
    
    
    Private Sub txtAssignedStaffCalendar_GotFocus()
        Dim strSQL As String
        strSQL = "SELECT StaffNum, CompanyName, FirstName, LastName FROM tblStaff ORDER BY StaffNum ASC "
        Me![txtAssignedStaffCalendar].RowSource = strSQL
        Me![txtAssignedStaffCalendar].Requery
    End Sub
    
    
    Private Sub txtSelectMonth_Click()
    On Error GoTo ErrorHandler
        Call Main
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtSelectYear_AfterUpdate()
    On Error GoTo ErrorHandler
        Call Main
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Public Sub Main()
    On Error GoTo ErrorHandler
        Call InitVariables
        Call InitArray
        Call LoadArray
        Call PrintArray
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Public Sub InitVariables()
    On Error GoTo ErrorHandler
        intYear = Me![txtSelectYear]
        intMonth = Me![txtSelectMonth]
        lngFirstDayOfMonth = CLng(DateSerial(intYear, intMonth, 1))
        intFirstWeekday = getFirstWeekday(lngFirstDayOfMonth)
        intDaysInMonth = getDaysInMonth(lngFirstDayOfMonth)
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Public Sub InitArray()
    On Error GoTo ErrorHandler
        Dim i As Integer
        ReDim MyArray(0 To 41, 0 To 3)
        For i = 0 To 41
            MyArray(i, 0) = lngFirstDayOfMonth + 1 - intFirstWeekday + i
            If Month(MyArray(i, 0)) = intMonth Then
                MyArray(i, 1) = True
                MyArray(i, 2) = i + 2 - intFirstWeekday & vbNewLine
            Else
                MyArray(i, 1) = False
            End If
        Next i
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Public Sub LoadArray()
    On Error GoTo ErrorHandler
        Dim db As Database
        Dim rs As Recordset
        Dim rsFiltered As Recordset
        Dim strSQL As String
        Dim i As Integer
        strSQL = "SELECT tblCalendarData.CalendarDate, tblCalendarData.CalendarTime, tblCalendarData.ActivityNumber, tblCalendarData.CalendarCity, tblCalendarData.CalendarState, tblCalendarData.StaffNum, tblCalendarData.AssignedCaseGroup, tblCalendarData.AssignedManagerGroup, tblCalendarData.AssignedDepartmentGroup " _
                & "FROM tblCalendarData " _
                & "WHERE tblCalendarData.[AssignedDepartmentGroup] = '" & Me.txtAssignedDeptGroupCalendar & "' AND tblCalendarData.[AssignedManagerGroup] = '" & Me.txtAssignedMgrGroupCalendar & "' AND tblCalendarData.[AssignedCaseGroup] = '" & Me.txtAssignedCaseGroupCalendar & "' AND tblCalendarData.[StaffNum] = '" & Me.txtAssignedStaffCalendar & "' " _
                & "ORDER BY tblCalendarData.CalendarDate "
        Set db = CurrentDb
        Set rs = db.OpenRecordset(strSQL)
        With rs
            If Not rs.BOF And Not rs.EOF Then
                For i = 0 To UBound(MyArray)
                    If MyArray(i, 1) = True Then
                        .Filter = "[CalendarDate]=" & MyArray(i, 0)
                        Set rsFiltered = .OpenRecordset
                        If Not rsFiltered.BOF And Not rsFiltered.EOF Then
                            Do While Not rsFiltered.EOF = True
                                MyArray(i, 2) = MyArray(i, 2) & vbNewLine & rsFiltered!CalendarTime
                                MyArray(i, 2) = MyArray(i, 2) & " - " & rsFiltered!ActivityNumber
                                MyArray(i, 2) = MyArray(i, 2) & " " & rsFiltered!CalendarCity
                                MyArray(i, 2) = MyArray(i, 2) & " " & rsFiltered!CalendarState
                            rsFiltered.MoveNext
                            Loop
                        End If
                    End If
                Next i
        End If
            .Close
    End With
    ExitSub:
        Set db = Nothing
        Set rs = Nothing
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Public Sub PrintArray()
    On Error GoTo ErrorHandler
        Dim strTextBox As String
        Dim i As Integer
        For i = 0 To 41
            strTextBox = "txtbox" & CStr(i + 1)
            With Me
                Controls(strTextBox) = ""
                Controls(strTextBox).Tag = i + 1
                Controls(strTextBox) = MyArray(i, 2)
            End With
        Next i
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub OpenContinuousForm(ctlName As String)
    On Error GoTo ErrorHandler
        Dim ctlValue As Integer
        Dim DayOfMonth As Long
        ctlValue = Me.Controls(ctlName).Tag
        DayOfMonth = MyArray(ctlValue - 1, 0)
        DoCmd.OpenForm "frmCalendarData", acNormal, , "[CalendarDate]=" & DayOfMonth
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox1_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox2_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox3_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox4_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox5_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox6_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox7_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox8_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox9_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox10_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox11_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox12_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox13_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox14_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox15_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox16_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox17_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox18_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox19_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox20_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox21_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox22_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox23_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox24_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox25_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox26_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox27_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox28_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox29_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox30_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox31_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox32_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox33_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox34_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox35_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox36_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox37_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox38_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox39_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox40_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox41_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtbox42_Click()
    On Error GoTo ErrorHandler
        If Me.ActiveControl.text <> "" Then
            Call OpenContinuousForm(Me.ActiveControl.Name)
        End If
    ExitSub:
        Exit Sub
    ErrorHandler:
        MsgBox Err.Description, vbOKOnly, ""
        Resume ExitSub
    End Sub
    
    
    Private Sub txtSelectDeptGroupCalendar_GotFocus()
        Dim strSQL As String
        strSQL = "SELECT DepartmentGroupName FROM tlkpDepartmentGroup ORDER BY ID "
        Me![txtSelectDeptGroupCalendar].RowSource = strSQL
        Me![txtSelectDeptGroupCalendar].Requery
    End Sub
    
    
    Private Sub txtSelectMgrGroupCalendar_GotFocus()
        Dim strSQL As String
        strSQL = "SELECT ManagerGroupName FROM tlkpManagerGroup ORDER BY ID "
        Me![txtSelectMgrGroupCalendar].RowSource = strSQL
        Me![txtSelectMgrGroupCalendar].Requery
    End Sub
    
    
    Private Sub txtSelectCaseGroupCalendar_GotFocus()
        Dim strSQL As String
        strSQL = "SELECT CaseGroupName FROM tlkpCaseGroup ORDER BY ID "
        Me![txtSelectCaseGroupCalendar].RowSource = strSQL
        Me![txtSelectCaseGroupCalendar].Requery
    End Sub
    
    
    Private Sub txtSelectStaffCalendar_GotFocus()
        Dim strSQL As String
        strSQL = "SELECT StaffNum, CompanyName, FirstName, LastName FROM tblStaff ORDER BY ID "
        Me![txtSelectStaffCalendar].RowSource = strSQL
        Me![txtSelectStaffCalendar].Requery
    End Sub
    
    Private Sub btnPreviousMonth_Click()
    On Error GoTo btnPreviousMonth_Click_Err
        Dim January, February, March, April, May, June, July, August, September, October, November, December
        January = 1
        February = 2
        March = 3
        April = 4
        May = 5
        June = 6
        July = 7
        August = 8
        September = 9
        October = 10
        November = 11
        December = 12
        If Me![txtSelectMonth] = 2 - 1 Then
            Me![txtSelectMonth] = 12
            Me![txtSelectYear] = Me![txtSelectYear] - 1
        Else
            Me![txtSelectMonth] = Me![txtSelectMonth] - 1
        End If
    btnPreviousMonth_Click_Exit:
        Exit Sub
    btnPreviousMonth_Click_Err:
        Beep
        MsgBox Err.Description, vbOKOnly, ""
        Resume btnPreviousMonth_Click_Exit
    End Sub
    
    
    Private Sub btnNextMonth_Click()
    On Error GoTo btnNextMonth_Click_Err
        Dim January, February, March, April, May, June, July, August, September, October, November, December
        January = 1
        February = 2
        March = 3
        April = 4
        May = 5
        June = 6
        July = 7
        August = 8
        September = 9
        October = 10
        November = 11
        December = 12
        If Me![txtSelectMonth] = 11 + 1 Then
            Me![txtSelectMonth] = 1
            Me![txtSelectYear] = Me![txtSelectYear] + 1
        Else
            Me![txtSelectMonth] = Me![txtSelectMonth] + 1
        End If
    btnNextMonth_Click_Exit:
        Exit Sub
    btnNextMonth_Click_Err:
        Beep
        MsgBox Err.Description, vbOKOnly, ""
        Resume btnNextMonth_Click_Exit
    End Sub
    
    Private Sub btnRefresh_Click()
    On Error GoTo btnRefresh_Click_Err
        Call Form_Load
    btnRefresh_Click_Exit:
        Exit Sub
    btnRefresh_Click_Err:
        Beep
        MsgBox Err.Description, vbOKOnly, ""
        Resume btnRefresh_Click_Exit
    End Sub
    
    
    Private Sub btnCalendarClose_Click()
    On Error GoTo btnCalendarClose_Click_Err
        If Me.Dirty Then
            DoCmd.RunCommand acCmdUndo
        Else
            DoCmd.Close acForm, Me.Name
        End If
        DoCmd.Close acForm, Me.Name
    btnCalendarClose_Click_Exit:
        Exit Sub
    btnCalendarClose_Click_Err:
        MsgBox Err.Description, vbOKOnly, ""
        Resume btnCalendarClose_Click_Exit
    End Sub

    Click image for larger version. 

Name:	Capture.JPG 
Views:	52 
Size:	43.4 KB 
ID:	39601
    CALENDAR DATA FORM:
    Code:
    Option Compare Database
    
    
    Private Sub Form_Load()
        Me![txtAssignedDeptGroupCalendar] = [Forms]![frmCalendar]![txtAssignedDeptGroupCalendar]
        Me![txtAssignedMgrGroupCalendar] = [Forms]![frmCalendar]![txtAssignedMgrGroupCalendar]
        Me![txtAssignedCaseGroupCalendar] = [Forms]![frmCalendar]![txtAssignedCaseGroupCalendar]
        Me![txtAssignedStaffCalendar] = [Forms]![frmCalendar]![txtAssignedStaffCalendar]
    End Sub
    
    
    Private Sub btnAdd_Click()
    On Error GoTo btnAdd_Click_Err
        DoCmd.GoToRecord , "", acNewRec
    btnAdd_Click_Exit:
        Exit Sub
    btnAdd_Click_Err:
        Beep
        MsgBox Err.Description, vbOKOnly, ""
        Resume btnAdd_Click_Exit
    End Sub
    
    
    Private Sub btnSave_Click()
    On Error GoTo btnSave_Click_Err
        If Me.Dirty = False Then
            Beep
            MsgBox "Nothing to Save.", , ""
        Else
            DoCmd.RunCommand acCmdSaveRecord
        End If
    btnSave_Click_Exit:
        Exit Sub
    btnSave_Click_Err:
        Beep
        MsgBox Err.Description, vbOKOnly, ""
        Resume btnSave_Click_Exit
    End Sub
    
    
    Private Sub btnUndo_Click()
    On Error GoTo btnUndo_Click_Err
        If Me.Dirty Then
            DoCmd.RunCommand acCmdUndo
        Else
            Beep
            MsgBox "Nothing to Undo.", , ""
        End If
    btnUndo_Click_Exit:
        Exit Sub
    btnUndo_Click_Err:
        Beep
        MsgBox Err.Description, vbOKOnly, ""
        Resume btnUndo_Click_Exit
    End Sub
    
    
    Private Sub btnDelete_Click()
    On Error GoTo btnDelete_Click_Err
        DoCmd.GoToControl Screen.PreviousControl.Name
        Err.Clear
        If (Not Form.NewRecord) Then
            DoCmd.RunCommand acCmdDeleteRecord
        ElseIf (Form.NewRecord And Form.Dirty) Then
            DoCmd.RunCommand acCmdUndo
        End If
    btnDelete_Click_Exit:
        Exit Sub
    btnDelete_Click_Err:
        Beep
        MsgBox Err.Description, vbOKOnly, ""
        Resume btnDelete_Click_Exit
    End Sub
    
    
    Private Sub btnCalendarDataClose_Click()
    On Error GoTo btnCalendarDataClose_Click_Err
        DoCmd.Close acForm, Me.Name
        Forms!frmCalendar.btnRefresh.SetFocus
        SendKeys "{ENTER}"
    btnCalendarDataClose_Click_Exit:
        Exit Sub
    btnCalendarDataClose_Click_Err:
        MsgBox Err.Description, vbOKOnly, ""
        Resume btnCalendarDataClose_Click_Exit
    End Sub
    
    
    Private Sub btnFirstRecord_Click()
    On Error GoTo btnFirstRecord_Click_Err
        DoCmd.GoToRecord , "", acFirst
    btnFirstRecord_Click_Exit:
        Exit Sub
    btnFirstRecord_Click_Err:
        Beep
        MsgBox Err.Description, vbOKOnly, ""
        Resume btnFirstRecord_Click_Exit
    End Sub
    
    
    Private Sub btnPreviousRecord_Click()
    On Error GoTo btnPreviousRecord_Click_Err
        On Error Resume Next
        DoCmd.GoToRecord , "", acPrevious
    btnPreviousRecord_Click_Exit:
        Exit Sub
    btnPreviousRecord_Click_Err:
        Beep
        MsgBox Err.Description, vbOKOnly, ""
        Resume btnPreviousRecord_Click_Exit
    End Sub
    
    
    Private Sub btnNextRecord_Click()
    On Error GoTo btnNextRecord_Click_Err
        On Error Resume Next
        DoCmd.GoToRecord , "", acNext
    btnNextRecord_Click_Exit:
        Exit Sub
    btnNextRecord_Click_Err:
        Beep
        MsgBox Err.Description, vbOKOnly, ""
        Resume btnNextRecord_Click_Exit
    End Sub
    
    
    Private Sub btnLastRecord_Click()
    On Error GoTo btnLastRecord_Click_Err
        DoCmd.GoToRecord , "", acLast
    btnLastRecord_Click_Exit:
        Exit Sub
    btnLastRecord_Click_Err:
        Beep
        MsgBox Err.Description, vbOKOnly, ""
        Resume btnLastRecord_Click_Exit
    End Sub
    Last edited by SierraJuliet; 08-29-2019 at 12:03 AM.

  9. #9
    accesstos's Avatar
    accesstos is offline Expert
    Windows XP Access 2007
    Join Date
    Dec 2018
    Location
    Greece
    Posts
    551
    Nice user interface , but -too many code!...

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Work Week Calendar!
    By cap.zadi in forum Access
    Replies: 5
    Last Post: 10-10-2018, 02:43 AM
  2. Populate Outlook calendar with Access Form
    By Artecy in forum Import/Export Data
    Replies: 1
    Last Post: 02-12-2014, 04:51 PM
  3. Counting Days of the Week
    By losingmymind in forum Reports
    Replies: 10
    Last Post: 12-23-2013, 03:30 PM
  4. How to Calculate days of the week
    By djclntn in forum Database Design
    Replies: 3
    Last Post: 02-26-2011, 11:10 PM
  5. Replies: 0
    Last Post: 09-27-2009, 02:14 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums