Я не очень хорошо понимаю 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