Private Sub OK_Click()
　　On Error GoTo OK_Click_Error
　　 
　　    Dim dbl30Minutes As Double
　　    Dim dblTimeIncr  As Double
　　    Dim dblCurrentTime As Double
　　    Dim dblBeginTime As Double
　　    Dim dblEndTime As Double
　　    
　　    Dim intCurrentTime As Integer    'used to test times in aTimeSlots array
　　    Dim intBeginTime As Integer
　　    Dim intEndTime As Integer
　　    
　　    Dim dblCurrentDate As Date
　　    Dim dblBeginDate As Date
　　    Dim dblEndDate As Date
　　    
　　    Dim fSkipDay As Boolean         'flags used to track various states
　　    Dim fSkipTime As Boolean
　　    Dim fPreviousRecs As Boolean
　　    
　　    Dim lngResourceID As Long
　　    Dim lngScheduleId As Long
　　    Dim strCriteria As String
　　 
　　    If IsNull(Me![開始時刻]) Or IsNull(Me![終了時間]) Then
　　         MsgBox "開始時刻と終了時刻を先に入力してください。"
　　         DoCmd.GoToControl "開始時刻"
　　         Exit Sub
　　    End If
　　 
　　    If Me![開始時刻].ListIndex >= Me![終了時間].ListIndex Then
　　         MsgBox "終了時刻は、開始時刻よりも後の時刻を指定してください。"
　　         DoCmd.GoToControl "開始時刻"
　　         Exit Sub
　　    End If
　　 
　　    If Me![期間自] > Me![期間至] Then
　　         MsgBox "期間至には、期間自よりも後の日付を指定してください。"
　　         DoCmd.GoToControl "開始時刻"
　　         Exit Sub
　　    End If
　　 
　　    DoCmd.Hourglass True
　　    lngResourceID = Me![レンタル商品ID]
　　    dbl30Minutes = TimeSerial(2, 30, 0) - TimeSerial(2, 0, 0)
　　    dblBeginTime = Me![開始時刻].ListIndex * dbl30Minutes
　　    dblEndTime = Me![終了時間].ListIndex * dbl30Minutes
　　    dblTimeIncr = dbl30Minutes * Me![予約単位].Column(0)  'column 0 contains the number of 30 minute time segments in the time increment
　　    
　　    Set dbs = CurrentDb()
　　    Set rstSchedule = dbs.OpenRecordset("スケジュール", dbOpenDynaset)
　　    Set rstScheduleDtl = dbs.OpenRecordset("スケジュール詳細")
　　    
　　    dblBeginDate = Me![期間自]
　　    dblEndDate = Me![期間至]
　　    dblCurrentDate = dblBeginDate
　　    
　　    While dblCurrentDate <= dblEndDate
　　        If (Not SkipThisDay(DatePart("w", dblCurrentDate))) Then
　　            rstSchedule.FindFirst "[レンタル商品ID]=" & Me![レンタル商品ID] & " AND [予定日]= #" & Format(dblCurrentDate, "m-d-yy") & "#"
　　            If rstSchedule.NoMatch Then
　　                rstSchedule.AddNew
　　                rstSchedule![レンタル商品ID] = lngResourceID
　　                rstSchedule![予定日] = dblCurrentDate
　　                lngScheduleId = rstSchedule![スケジュールID]
　　                rstSchedule.Update
　　                fPreviousRecs = False
　　            Else
　　                lngScheduleId = rstSchedule![スケジュールID]
　　            End If
　　            fPreviousRecs = isPreviousRecs(lngResourceID, dblCurrentDate)  'sets flag and loads atimeSlots array if applicable
　　            
　　            dblCurrentTime = dblBeginTime
　　            intCurrentTime = Me![開始時刻].ListIndex + 48
　　            intBeginTime = intCurrentTime
　　            intEndTime = intBeginTime + Me![予約単位].Column(0)
　　            Do
　　                fSkipTime = False
　　                If fPreviousRecs Then
　　                    If isOverlap(intBeginTime, intEndTime) Then
　　                        fSkipTime = True
　　                    End If
　　                    intBeginTime = intBeginTime + Me![予約単位].Column(0)
　　                    intEndTime = intBeginTime + Me![予約単位].Column(0)
　　                End If
　　                If fSkipTime = False Then
　　                    rstScheduleDtl.AddNew
　　                    rstScheduleDtl![スケジュールID] = lngScheduleId
　　                    rstScheduleDtl![開始予定時刻] = Format(dblCurrentTime, "hh:mm AMPM")
　　                    rstScheduleDtl![終了予定時刻] = Format(dblCurrentTime + dblTimeIncr, "hh:mm AMPM")
　　                    rstScheduleDtl.Update
　　                End If
　　                dblCurrentTime = dblCurrentTime + dblTimeIncr
　　            Loop Until (dblCurrentTime + dblTimeIncr) > (dblEndTime + 0.01) 'the .01 adds a few minutes to deal with small number precision issues
　　        End If
　　        dblCurrentDate = dblCurrentDate + 1
　　    Wend
　　 
　　    DoCmd.Close acForm, "スケジュールの作成"
　　    rstSchedule.Close
　　    rstScheduleDtl.Close
　　    dbs.Close
　　 
　　OK_Click_Exit:
　　    DoCmd.Hourglass False
　　    Exit Sub
　　 
　　OK_Click_Error:
　　    MsgBox Err.Description
　　    Resume OK_Click_Exit
　　End Sub