Как заполнить текст из формы, содержащей даты начала и окончания, в мой календарь - PullRequest
0 голосов
/ 20 июня 2019

Я не очень хорошо понимаю VBA, поэтому мне очень помогает интернет для создания простого офисного календаря, в котором сотрудники могут заполнить форму запроса на перерыв и отправить ее руководителю.Форма содержит поля: EmployeeName, StartDate, EndDate, StartTime, EndTime, Memo и т. Д. На данный момент у меня есть следующее: если супервизор одобрит запрос, он будет отображаться в календаре, показывая «8:00 AM - 5».: 00:00 Имя сотрудника вышло на весь день "для выбранной начальной даты.

Однако я не уверен, как получить текст для копирования в каждое соответствующее текстовое поле в календаре в зависимости от дат, введенных в StartDate и EndDate.В настоящее время заполняемый текст основан только на начальной дате, которая работает нормально, если сотрудник запрашивает несколько часов в день, но не если он хочет запросить целую неделю отпуска.Для этого им нужно будет заполнить форму запроса на каждый выходной день.

Option Explicit

Private intMonth As Integer
Private intYear As Integer
Private lngFirstDayOfMonth As Long
Private intFirstWeekday As Integer
Private intDaysInMonth As Integer
Private myArray() As Variant

Private Sub Form_Load()
With Me
     .cboMonth = Month(Date)
     .cboYear = Year(Date)
End With

Call Main

End Sub


Private Sub cboMonth_AfterUpdate()
On Error GoTo ErrorHandler

Call Main

ExitSub:
    Exit Sub

ErrorHandler:
    MsgBox "There has been an error. Please reload the form"
    Resume ExitSub

End Sub


Private Sub cboYear_AfterUpdate()
On Error GoTo ErrorHandler

Call Main

ExitSub:
    Exit Sub

ErrorHandler:
    MsgBox "There has been an error. Please reload the form"
    Resume ExitSub
End Sub

Private Sub Main()
On Error GoTo ErrorHandler

Call InitVariables
Call InitArray
Call LoadArray
Call PrintArray



ExitSub:
    Exit Sub
ErrorHandler:
    MsgBox "There has been an error. Please reload the form"
    Resume ExitSub
End Sub

Private Sub InitVariables()
On Error GoTo ErrorHandler

intMonth = Me.cboMonth
intYear = Me.cboYear
lngFirstDayOfMonth = CLng(DateSerial(intYear, intMonth, 1))
intFirstWeekday = getFirstWeekday(lngFirstDayOfMonth)
intDaysInMonth = getDaysInMonth(intMonth, intYear)

ExitSub:
    Exit Sub

ErrorHandler:
    MsgBox "There has been an error. Please reload the form"
    Resume ExitSub
End Sub


Private Sub InitArray()
Dim i As Integer

ReDim myArray(0 To 41, 0 To 2)

For i = 0 To 41

    myArray(i, 0) = lngFirstDayOfMonth - intFirstWeekday + 1 + i
    If Month(myArray(i, 0)) = intMonth Then
        myArray(i, 1) = True
        myArray(i, 2) = Day(myArray(i, 0))
    Else
        myArray(i, 1) = False

    End If
Next i

End Sub

Private Sub LoadArray()

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rsFiltered As DAO.Recordset
Dim strSQL As String
Dim i As Integer

strSQL = "SELECT tblTimeOff.EmployeeID, tblTimeOff.StartDate, " _
    & "DLookUp('[LookupTime]','tblTimes','[LookupScheduleTime]=' & Replace(CStr([tblTimeOff].[StartTime]),',','.')) AS StartTime, " _
    & "DLookUp('[LookupTime]','tblTimes','[LookupScheduleTime]=' & Replace(CStr([tblTimeOff].[EndTime]),',','.')) AS EndTime, " _
    & "tblTimeOff.EmployeeID, tblTimeOff.Memo, Left([tblEmployees].[FirstName],10) AS Employee, " _
    & "tblTimeOff.EmployeeID, tblTimeOff.Approved AS Approved, " _
    & "tblTimeOff.EmployeeID, tblTimeOff.EndDate AS EndDate " _
    & "INNER JOIN (tblTimeOff INNER JOIN tblEmployees ON tblTimeOff.EmployeeID = tblEmployees.EmployeeID) " _
    & "WHERE tblTimeOff.Approved = True " _
    & "ORDER BY tblTimeOff.StartDate;"


Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)

    If Not rs.BOF And Not rs.EOF Then

        For i = LBound(myArray) To UBound(myArray)

            If myArray(i, 1) Then
                rs.Filter = "[StartDate]=" & myArray(i, 0)

                Set rsFiltered = rs.OpenRecordset

                Do While (Not rsFiltered.EOF)

                    myArray(i, 2) = myArray(i, 2) & vbNewLine _
                    & rsFiltered!StartTime & " - " _
                    & rsFiltered!EndTime & " " _
                    & rsFiltered!Employee & " " _
                    & rsFiltered!Memo

                    rsFiltered.MoveNext
                Loop

            End If
        Next i

    End If

    rsFiltered.Close
    rs.Close

Set rsFiltered = Nothing
Set rs = Nothing
Set db = Nothing


End Sub

Private Sub PrintArray()
On Error GoTo ErrorHandler

Dim strCtlName As String
Dim i As Integer

For i = LBound(myArray) To UBound(myArray)
    strCtlName = "txt" & CStr(i + 1)
    Controls(strCtlName).Tag = i
    Controls(strCtlName) = ""
    Controls(strCtlName) = myArray(i, 2)
Next i


ExitSub:
    Exit Sub
ErrorHandler:
    MsgBox "There has been an error. Please reload the form"
    Resume ExitSub

End Sub

Private Sub OpenContinuousForm(ctlName As String)
On Error GoTo ErrorHandler

Dim ctlValue As Integer
Dim dayOfMonth As Long


ctlValue = Controls(ctlName).Tag
dayOfMonth = myArray(ctlValue, 0)


ExitSub:
    Exit Sub
ErrorHandler:
    MsgBox "There has been an error. Please reload the form"
    Resume ExitSub

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...