タイムシートモジュール - Gettimesheetdataサブルーチン

Question

私はこの最初のAccessプロジェクトで長い道のりを歩んできましたが、現在のところ2週間以上この時点でひどく詰まっています！

この部分は、タイムシートフォームとタイムシートサブフォームがあるタイムシートモジュールです。フォームのヘッダー部分には、ユーザーが週末（金曜日）の日付を選択するコンボボックスがあります。今週の終了日は、タイムシート全体の主な基準です。この点までのすべては、私が適応することができたFennema氏のコードのおかげでうまくいきました。

コンボボックスで日付を選択したら、その週の5平日の作業時間があればメインテーブル（tblTimeSheetData）をチェックするために、afterupdateイベント（Gettimesheetdataサブルーチン）にコードを挿入する必要があります。 （おそらく、オンザフライでクエリを介して）、それがある場合は、ユーザーがその特定の週のタイムシートが既に完了しているかどうかを確認したり、調整したりできるように、サブフォームの適切なフィールドにtempテーブルを挿入する必要があります。レコードがない場合は、これが新しいタイムシートであることを意味します。それが新しいタイムシートである場合は、プロジェクトを選択して平日の時間を入力してメインテーブルに保存することもできます（以下のWritetimesheetdataサブルーチン）。プロジェクトに基づいて1日あたりの時間を入力すると、一時テーブルが作成され、「ワークシートを保存する」コマンドボタンは、水平方向のデータをメインテーブルの垂直方向に変換します。私はGettimesheetdataサブルーチンの正しい方向に私を導く助けに本当に感謝します。

ありがとうございます。

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

ないどのくらいこののは、あなたに有用であろうが、おそらくそれはあなたにいくつかのアイデアを与えるだろうしてください：ここでは

はWritetimesheetdataサブルーチンのコードです。リトル・リーグの審判の任務を追跡するために私のDBでいくつかのテストを行った。まず、必要なフィールドを持つ一時テーブルを作成します。

静的フィルタ条件を持つ保存された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 

クロス集計せずに同じ出力を達成：

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