Непрерывная форма MS Access не обновляется - PullRequest
0 голосов
/ 25 мая 2018

Так что я довольно новичок в Ms Access и VBA.Я пытаюсь создать шаблон календаря посещаемости, в котором

  • Я рассчитываю код посещаемости на основе посещаемости сотрудника
  • представить этот код в непрерывной форме, так как номер сотрудника довольноlarge

Я получил все необходимые запросы для всех необходимых данных, но я просто не могу отобразить их так, как хочу

Я использовал набор записей DAO, чтобы вытащитьданные и еще много чего.Я искал в Интернете все выше и ниже, но не могу найти и ответить, поэтому вот я.

Проблема:

  • вторая и последующие записи используют идентификационный номер первой записивместо своих.Текстовое поле Имя уже связано с запросом.

https://i.stack.imgur.com/TLeFJ.png

PS.Я использовал этот шаблон в качестве основы для кодирования 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

1 Ответ

0 голосов
/ 25 мая 2018

Использовал предложение @ dbmitch для привязки всех текстовых полей к запросу.Я использовал Transform Pivot в исходном запросе, чтобы создать необходимые имена столбцов, сопоставить их с соответствующими текстовыми полями.Я буду использовать VBA для их обновления, если я хочу посмотреть по-другому, но пока это работает.

...