所以我对Access和VBA女士来说相当新。我正在尝试创建一个考勤日历模板
我已经获得了所有必需数据的所有必要查询,但我似乎无法以我想要的方式显示
我使用DAO记录集来提取数据等等。我已经搜索了互联网的高低,但似乎无法找到并回答,所以我在这里。
问题:
https://i.stack.imgur.com/TLeFJ.png
PS。我使用this模板作为VBA编码的基础。
Public 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 30, 0 To 2)
For i = 0 To 30
myArray(i, 0) = lngFirstDayOfMonth - intFirstWeekday + 2 + 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 rs1 As DAO.Recordset
Dim rsFiltered As DAO.Recordset
Dim strSQL, strSQLTraxID As String
Dim i As Integer
'If Not rs.BOF And Not rs.EOF Then
For i = LBound(myArray) To UBound(myArray)
If myArray(i, 1) Then
strSQL = "SELECT EiSyS.Date, [CAM Database].[Trax ID], [CAM Database].[Full Name], EiSyS.AttendanceCode " _
& "FROM EiSyS INNER JOIN [CAM Database] ON EiSyS.EmployeeID = [CAM Database].[Trax ID] where EiSyS.Date = CDate('" & Format(myArray(i, 0), "mm/dd/yyyy") & "') and " _
& "EiSyS.EmployeeID = " & Me.[EmployeeID]
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
Set rsFiltered = rs.OpenRecordset
Do While (Not rsFiltered.EOF)
myArray(i, 2) = rs!AttendanceCode
Debug.Print Format(myArray(i, 0), "mm/dd/yyyy") & " - " & rs!AttendanceCode & " - " & Me.[EmployeeID]
rsFiltered.MoveNext
Loop
End If
Next i
'End If
rsFiltered.Close
rs.Close
Set rsFiltered = Nothing
Set rs = Nothing
Set rs1 = 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 = "text" & 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
答案 0 :(得分:0)
使用@ dbmitch的建议将所有文本框绑定到查询。我在原始查询上使用了Transform Pivot来创建必要的列名,匹配并将它们绑定到相应的文本框。如果我想以不同的方式查看它,我会大量使用VBA来更新它们,但到目前为止它都有效。