Question

我已经在我的第一个Access项目上走了很长一段路，但目前在这一点上已经停留了两个多星期！

这部分是时间表模块，其中有时间表格和时间表格;在表单的标题部分有一个组合框，用户选择周末（星期五）的日期。本周结束日期是整个时间表的主要标准。由于Fennema女士的一个代码我能够适应，所以到目前为止所做的一切似乎都很好。

一旦在组合框中选择了日期，我必须在其afterupdate事件（Gettimesheetdata子例程）中放置一个代码，如果该周的5个工作日有任何工作时间，则首先检查主表（tblTimeSheetData）; （可能是通过动态查询）如果有，它应该通过临时表将它们放在子表单中的适当字段中，以便用户可以验证特定周的时间表已经完成或进行调整它。如果没有记录，那就意味着这是一个新的时间表！如果它是一个新的时间表，选择项目并输入工作日的小时数并将它们保存到主表也似乎有效（下面的Writetimesheetdata子程序）。当您根据项目输入每天的小时数时，它会填充临时表，并且“保存工作表”命令按钮会将主要表格上的水平数据转换为垂直数据。我非常感谢任何帮助，以指导我在Gettimesheetdata子程序的正确方向。

谢谢。

以下是Writetimesheetdata子例程的代码：

Public Sub WriteTimesheetData()

     Set rstTime = CurrentDb.OpenRecordset("tblTimeSheetData", _
     dbOpenDynaset)
     Set rstTemp = CurrentDb.OpenRecordset("tblTimeSheetDataTemp")

With rstTemp
  .MoveLast
  .MoveFirst
  lngCount = .RecordCount
  Debug.Print lngCount & " records to write"

  If lngCount > 0 Then
     'Attempt to find matching record in tblTimeSheetData
     'Create or edit one record in tblTimeSheetData for each weekday
     'that has hours worked
     Do While Not .EOF
        lngProjectsID = Nz(![ProjectsID])
        lngActivityCode = Nz(![ActivityCode])

        dblWorkHours = Nz(![MondayWorkHours])

        If dblWorkHours > 0 Then
           dteWork = DateAdd("d", -4, _
              GetProperty("TimesheetWeekEnding", ""))


           If lngActivityCode <> 0 Then
              strSearch = "[ProjectsID] = " & lngProjectsID _
                 & " And [WorkDate] = " & Chr(35) & dteWork _
                 & Chr(35) & " And [ActivityCode] = " _
                 & lngActivityCode
           End If

           Debug.Print "Search string: " & strSearch
           rstTime.FindFirst strSearch

           If rstTime.NoMatch = False Then
              'Edit existing record
              rstTime.Edit
              rstTime![WorkHours] = dblWorkHours
              rstTime.Update

           Else
              'Add new record
              rstTime.AddNew
              rstTime![ProjectsID] = ![ProjectsID]
              rstTime![WorkDate] = dteWork
              rstTime![ActivityCode] = ![ActivityCode]
              rstTime![WorkHours] = dblWorkHours
              rstTime.Update
           End If

           'repeat same code for Tue, Wed, Thu and Fri

        End If

        .MoveNext
     Loop
  End If
 End With

ErrorHandlerExit:
Exit Sub

ErrorHandler:
MsgBox "Error No: " & Err.Number _
  & " in WriteTimesheetData procedure; " _
  & "Description: " & Err.Description
Resume ErrorHandlerExit

End Sub

Answer 1

不确定这对你有多大帮助，但也许会给你一些想法。我在我的数据库中进行了一些测试，以跟踪小联盟的裁判任务。首先，创建一个包含必要字段的临时表。

带有静态过滤条件的已保存CROSSTAB查询对象可以是INSERT操作的源，但CROSSTAB查询对象中的动态参数会导致错误;但是，VBA可以解决这个问题。

Dim rsPos As DAO.Recordset, rsSource As DAO.Recordset, rsTemp As DAO.Recordset
Set rsPos = CurrentDb.OpenRecordset("SELECT DISTINCT Position FROM Rates;")
Set rsTemp = CurrentDb.OpenRecordset("SELECT * FROM temp1 WHERE 1=1;")
CurrentDb.Execute "DELETE FROM temp1"
While Not rsPos.EOF
    Set rsSource = CurrentDb.OpenRecordset("TRANSFORM First(Rates.Rate) AS FirstRate " & _
                    "SELECT Rates.Position FROM Rates " & _
                    "WHERE (((Rates.Position)='" & rsPos!Position & "')) " & _
                    "GROUP BY Rates.Position PIVOT Rates.RateLevel;")
    While Not rsSource.EOF
        rsTemp.AddNew
        rsTemp!Position = rsSource!Position
        rsTemp!Junior = rsSource!Junior
        rsTemp!Major = rsSource!Major
        rsTemp!Minor = rsSource!Minor
        rsTemp!MinorA = rsSource!MinorA
        rsSource.MoveNext
        rsTemp.Update
    Wend
    rsSource.Close
    rsPos.MoveNext
Wend
rsPos.Close

以下代码在没有CROSSTAB的情况下完成相同的输出：

Dim rsPos As DAO.Recordset, rsSource As DAO.Recordset, rsTemp As DAO.Recordset, i As Integer
Set rsPos = CurrentDb.OpenRecordset("SELECT DISTINCT Position FROM Rates;")
Set rsTemp = CurrentDb.OpenRecordset("SELECT Position, Junior, Major, Minor, MinorA FROM temp1 WHERE 1=1;")
CurrentDb.Execute "Delete FROM temp1"
While Not rsPos.EOF
    Set rsSource = CurrentDb.OpenRecordset("SELECT Position, RateLevel, Rate FROM Rates WHERE Position = '" & rsPos!Position & "' ORDER BY RateLevel;")
    While Not rsSource.EOF
        rsTemp.AddNew
        rsTemp!Position = rsSource!Position
        For i = 1 To 4
            rsTemp.Fields(i) = rsSource!Rate
            rsSource.MoveNext
        Next
        rsTemp.Update
    Wend
    rsSource.Close
    rsPos.MoveNext
Wend
rsPos.Close

时间表模块 - Gettimesheetdata子例程

1 个答案: