Option Compare Database

'Ver.4 CREATE       2013/01/22

'MAKE 2013/01/24

'UPDATE             2013/01/30  

 

 

Const HIDUKE_TSUKEKAE_CODE = 9

 

Dim HANDLE_CNT(7 + 1) As Integer

Dim EV_TBL_VALID_CNT As Integer

Dim EV_TBL(366 + 1) As String

 

Private Function get_kind_of_lecday(ByVal kbn As Integer) As String

 

Dim db As DAO.Database

Dim rs As DAO.Recordset

Dim strSQL As String

 

    get_kind_of_lecday = "NOT FOUND"

   

    Set db = CurrentDb

   

    strSQL = "SELECT dat_nm FROM T_MST_NAME WHERE category='lecday_datetype'"

    strSQL = strSQL & " AND dat_cd=" & kbn & ";"

    Set rs = db.OpenRecordset(strSQL)

    If rs.RecordCount > 0 Then get_kind_of_lecday = rs.Fields("dat_nm")

   

    rs.Close

    Set rs = Nothing

    db.Close

    Set db = Nothing

 

End Function

 

Private Sub make_calender_main(ByVal nense As Integer, ByVal mm As Integer)

 

Dim db, db2 As DAO.Database

Dim rs, rs2 As DAO.Recordset

Dim strSQL As String

Dim i, DayOfTheWeek As Integer

Dim dd, UpdItem, tmp, strcnt, key_wk As String

 

    Set db = CurrentDb

    Set db2 = CurrentDb

 

    If mm = 4 Or mm = 10 Then

   

        For i = 0 To UBound(HANDLE_CNT)

       

            HANDLE_CNT(i) = 0

           

        Next i

       

    End If

           

    strSQL = "SELECT yyyymmdd, lecday_datetype, org_yyyymmdd FROM T_LECDAY_DEF WHERE nenndo=" & yyyy.Value

    strSQL = strSQL & " AND nense=" & nense

    strSQL = strSQL & " AND (Month(yyyymmdd))=" & mm & " ORDER BY yyyymmdd;"

    Set rs = db.OpenRecordset(strSQL)

 

    Do Until rs.EOF

 

        DayOfTheWeek = Weekday(rs.Fields("yyyymmdd"))

        UpdItem = "mon" & CStr(nense)

        If DayOfTheWeek = 3 Then UpdItem = "tue" & CStr(nense)

        If DayOfTheWeek = 4 Then UpdItem = "wed" & CStr(nense)

        If DayOfTheWeek = 5 Then UpdItem = "thu" & CStr(nense)

        If DayOfTheWeek = 6 Then UpdItem = "fri" & CStr(nense)

        If DayOfTheWeek = 7 Then UpdItem = "sat" & CStr(nense)

 

        'CODEが10未満を授業とみなす(非常に重要なファクタ)

        Select Case rs.Fields("lecday_datetype")

            Case TEST_DATE_CODE

                key_wk = "前期テスト"

                If mm = 1 Or mm = 2 Then key_wk = "後期テスト"         '2月食い込み年を想定

            Case FIRST_COMING_DATE_CODE, PRE_ENTRANCE_CEREMONY_DATE_CODE, ENTRANCE_CEREMONY_DATE_CODE, GUIDANCE_DATE_CODE

                key_wk = "message1"

                EV_TBL_VALID_CNT = EV_TBL_VALID_CNT + 1

                EV_TBL(EV_TBL_VALID_CNT) = get_kind_of_lecday(rs.Fields("lecday_datetype")) _

                        & ":" & CStr(Month(rs.Fields("yyyymmdd"))) & "月" & _

                                CStr(Day(rs.Fields("yyyymmdd"))) & _

                                        "日(" & WeekdayName(Weekday(rs.Fields("yyyymmdd")), True) & ")  "

            Case Else       '通常授業

                key_wk = CStr(mm)

        End Select

 

        strSQL = "SELECT " & UpdItem & " FROM T_LECDAY_DEF_PRT_TMP "

        strSQL = strSQL & "WHERE title_colmn='" & key_wk & "';"

        Set rs2 = db.OpenRecordset(strSQL)

       

        If rs.Fields("lecday_datetype") <> HIDUKE_TSUKEKAE_CODE Then

            tmp = CStr(Day(rs.Fields("yyyymmdd")))

            If Len(tmp) = 1 Then tmp = " " & tmp

        Else

            tmp = "" & WeekdayName(Weekday(rs.Fields("org_yyyymmdd")), True) & "" & Day(rs.Fields("org_yyyymmdd"))

        End If

       

        Select Case rs.Fields("lecday_datetype")

            Case FIRST_COMING_DATE_CODE, PRE_ENTRANCE_CEREMONY_DATE_CODE, ENTRANCE_CEREMONY_DATE_CODE, GUIDANCE_DATE_CODE

                HANDLE_CNT(DayOfTheWeek) = HANDLE_CNT(DayOfTheWeek)

            Case Else

                HANDLE_CNT(DayOfTheWeek) = HANDLE_CNT(DayOfTheWeek) + 1

        End Select

       

        strcnt = CStr(HANDLE_CNT(DayOfTheWeek))

        If Len(strcnt) = 1 Then strcnt = " " & strcnt

       

        If chk_isnull(rs2.Fields(UpdItem)) = True Then

            dd = strcnt & " - " & tmp

        Else

            dd = rs2.Fields(UpdItem) & vbCrLf & strcnt & " - " & tmp

        End If

               

        strSQL = "UPDATE T_LECDAY_DEF_PRT_TMP SET "

        strSQL = strSQL & UpdItem & "='" & dd & "' "

        strSQL = strSQL & "WHERE title_colmn='" & key_wk & "';"

                   

        db2.Execute strSQL

           

        rs.MoveNext

           

    Loop

   

    rs.Close

    Set rs = Nothing

    db2.Close

    Set db2 = Nothing

    db.Close

    Set db = Nothing

 

End Sub

 

Private Sub make_calender()

 

Dim i, j As Integer

Dim tmp As String

 

    EV_TBL_VALID_CNT = 0

   

    For i = 0 To UBound(EV_TBL)

        EV_TBL(i) = ""

    Next i

 

    For i = 1 To 2

        For j = 4 To 12

            Call make_calender_main(i, j)

        Next j

        For j = 1 To 3

            Call make_calender_main(i, j)

        Next j

    Next i

   

    tmp = ""

   

    For i = 1 To EV_TBL_VALID_CNT

        tmp = tmp & EV_TBL(i)

    Next i

 

    hidden_data.Value = tmp

 

End Sub

 

Private Sub print_tmp_file_init()

 

Dim db As DAO.Database

Dim strSQL As String

Dim i, mon As Integer

Dim tmp As String

 

    Set db = CurrentDb

    strSQL = "DELETE * FROM T_LECDAY_DEF_PRT_TMP"

    db.Execute strSQL

   

    For i = 1 To 12 + 2 + 2

   

        tmp = "前期テスト"

        If i = 12 Then tmp = "後期テスト"

        If i >= 1 And i <= 6 Then tmp = CStr(i + 3)

        If i >= 8 And i <= 10 Then tmp = CStr(i + 2)

        If i = 11 Then tmp = CStr(1)

        If i >= 13 And i <= 14 Then tmp = CStr(i - 11)

        If i = 15 Then tmp = "message1"

        If i = 16 Then tmp = "message2"

   

        strSQL = "INSERT INTO T_LECDAY_DEF_PRT_TMP(sort_seq, title_colmn) "

        strSQL = strSQL & "VALUES(" & i & ", '" & tmp & "');"

        db.Execute strSQL

       

    Next i

 

    db.Close

    Set db = Nothing

 

End Sub

 

Private Function is_holiday(ByRef yyyymmdd As Date) As Boolean

 

Dim db As DAO.Database

Dim rs As DAO.Recordset

Dim strSQL As String

 

    is_holiday = False

   

    Set db = CurrentDb

   

    strSQL = "SELECT * FROM T_HOLIDAY_DEF WHERE yyyymmdd=#" & yyyymmdd & "#;"

    Set rs = db.OpenRecordset(strSQL)

    If rs.RecordCount > 0 Then is_holiday = True

   

    rs.Close

    Set rs = Nothing

    db.Close

    Set db = Nothing

 

End Function

 

Private Sub chk_the_day_of_the_week()

 

Dim tmp As Date

Dim error_field, error_type As Integer

Dim msg As String

 

On Error GoTo EXCEPTION_SECTION

 

    error_type = -1

 

    error_field = 1

    tmp = DateValue(yyyy.Value & "/" & mm01.Value & "/" & dd01.Value)

    error_type = Weekday(tmp)

    If error_type = 1 Or (sat_chk.Value = False And error_type = 7) Then GoTo EXCEPTION_SECTION

    If (is_holiday(tmp) = True) Then

        error_type = -2

        GoTo EXCEPTION_SECTION

    End If

 

    error_field = 2

    tmp = DateValue(yyyy.Value & "/" & mm02.Value & "/" & dd02.Value)

    error_type = Weekday(tmp)

    If error_type = 1 Or (sat_chk.Value = False And error_type = 7) Then GoTo EXCEPTION_SECTION

    If (is_holiday(tmp) = True) Then

        error_type = -2

        GoTo EXCEPTION_SECTION

    End If

 

    error_field = 3

    tmp = DateValue(yyyy.Value & "/" & mm03.Value & "/" & dd03.Value)

    error_type = Weekday(tmp)

    If error_type = 1 Or (sat_chk.Value = False And error_type = 7) Then GoTo EXCEPTION_SECTION

    If (is_holiday(tmp) = True) Then

        error_type = -2

        GoTo EXCEPTION_SECTION

    End If

 

    error_field = 4

    tmp = DateValue(yyyy.Value & "/" & mm04.Value & "/" & dd04.Value)

    error_type = Weekday(tmp)

    If error_type = 1 Or (sat_chk.Value = False And error_type = 7) Then GoTo EXCEPTION_SECTION

    If (is_holiday(tmp) = True) Then

        error_type = -2

        GoTo EXCEPTION_SECTION

    End If

   

On Error GoTo 0

 

    Exit Sub

 

EXCEPTION_SECTION:

 

    Select Case error_type

        Case -2

            msg = "指定された日付は祝祭日です。"

        Case -1

            msg = "年月日に妥当性がありません。"

        Case 1

            msg = "指定された日付は日曜日です。"

        Case 7

            msg = "土曜日は休校設定されています。" & vbCrLf & "指定された日付は土曜日です。"

        Case Else

            msg = "年月日に妥当性がありません。"

    End Select

           

    error_type = MsgBox(msg, vbCritical, "DATE ERROR")

    If error_field = 1 Then mm01.SetFocus

    If error_field = 2 Then mm02.SetFocus

    If error_field = 3 Then mm03.SetFocus

    If error_field = 4 Then mm04.SetFocus

 

End Sub

 

Private Sub set_mode_sw_forecolor(ByRef para As Boolean)

 

    mode_sw.ForeColor = vbRed

    mode_sw.FontBold = True

    If para = False Then mode_sw.ForeColor = vbBlack

    If para = False Then mode_sw.FontBold = False

 

End Sub

 

Private Sub change_second_stage()

 

Dim tmp As Date

 

    tmp = DateValue(yyyy.Value & "/" & mm04.Value & "/" & dd04.Value)

    tmp = DateAdd("d", 1, tmp)

    mm09.Value = Format(Month(tmp), "00")

    dd09.Value = Format(Day(tmp), "00")

 

End Sub

 

Private Sub change_first_stage()

 

Dim tmp As Date

 

    tmp = DateValue(yyyy.Value & "/" & mm01.Value & "/" & dd01.Value)

    tmp = DateAdd("d", -1, tmp)

    If Weekday(tmp) = 1 Then tmp = DateAdd("d", -1, tmp)

    mm10.Value = Format(Month(tmp), "00")

    dd10.Value = Format(Day(tmp), "00")

 

End Sub

 

Private Sub put_save_parameter()

 

Dim db As DAO.Database

Dim rs As DAO.Recordset

Dim strSQL As String

Dim i As Integer

 

    Set db = CurrentDb

    strSQL = "INSERT INTO T_LECDAY_PARAMETER_SAVE(yyyy, nense, sat_chk, time_stamp, "

   

    For i = 1 To 10

        If i <> 10 Then

            strSQL = strSQL & "mm" & Format(i, "00") & ", " & "dd" & Format(i, "00") & ", "

        Else

            strSQL = strSQL & "mm" & Format(i, "00") & ", " & "dd" & Format(i, "00") & ") "

        End If

    Next i

   

    strSQL = strSQL & "VALUES(" & Val(yyyy.Value) & ", " & nense.Value

    strSQL = strSQL & ", " & sat_chk.Value & ", " & "#" & Now() & "#, "

    strSQL = strSQL & "'" & mm01.Value & "', '" & dd01.Value & "', "

    strSQL = strSQL & "'" & mm02.Value & "', '" & dd02.Value & "', "

    strSQL = strSQL & "'" & mm03.Value & "', '" & dd03.Value & "', "

    strSQL = strSQL & "'" & mm04.Value & "', '" & dd04.Value & "', "

    strSQL = strSQL & "'" & mm05.Value & "', '" & dd05.Value & "', "

    strSQL = strSQL & "'" & mm06.Value & "', '" & dd06.Value & "', "

    strSQL = strSQL & "'" & mm07.Value & "', '" & dd07.Value & "', "

    strSQL = strSQL & "'" & mm08.Value & "', '" & dd08.Value & "', "

    strSQL = strSQL & "'" & mm09.Value & "', '" & dd09.Value & "', "

    strSQL = strSQL & "'" & mm10.Value & "', '" & dd10.Value & "');"

   

    db.Execute strSQL

 

    db.Close

    Set db = Nothing

 

End Sub

 

Private Function set_mode_sw_caption(ByRef para As Boolean) As String

 

    set_mode_sw_caption = "春季休暇期間自動設定オフ"

    If para = True Then set_mode_sw_caption = "春季休暇期間自動設定オン"

 

End Function

 

Private Function boolean_message(ByRef para As Boolean) As String

 

    boolean_message = "なし"

    If para = True Then boolean_message = "あり"

 

End Function

 

Private Sub get_save_parameter(ByRef FunctionMode As String)

 

Dim db As DAO.Database

Dim rs As DAO.Recordset

Dim strSQL, wk As String

Dim i, wk_yyyy As Integer

Dim tmp As Date

 

    Set db = CurrentDb

    strSQL = "SELECT yyyy, nense, sat_chk, time_stamp, "

   

    For i = 1 To 10

        If i <> 10 Then

            strSQL = strSQL & "mm" & Format(i, "00") & ", " & "dd" & Format(i, "00") & ", "

        Else

            strSQL = strSQL & "mm" & Format(i, "00") & ", " & "dd" & Format(i, "00") & " "

        End If

    Next i

   

    If FunctionMode = "CMD" Then

        strSQL = strSQL & "FROM T_LECDAY_PARAMETER_SAVE WHERE time_stamp=#" & hist_lst.Value & "#;"

    Else

        strSQL = strSQL & "FROM T_LECDAY_PARAMETER_SAVE ORDER BY time_stamp DESC;"

    End If

 

    Set rs = db.OpenRecordset(strSQL)

   

    If FunctionMode = "AUTO" Then rs.MoveFirst                     'AUTO時は直近パラメタを獲得する

 

    yyyy.Value = rs.Fields("yyyy")

    nense.Value = rs.Fields("nense")

   

    For i = 1 To 10

        Me.Controls("mm" & Format(i, "00")).Value = rs.Fields("mm" & Format(i, "00"))

        Me.Controls("dd" & Format(i, "00")).Value = rs.Fields("dd" & Format(i, "00"))

    Next i

 

    sat_chk.Value = rs.Fields("sat_chk")

    sat_chk_mes.Value = boolean_message(sat_chk.Value)

   

    wk = "■休暇    "

   

    For i = 5 To 10                             '2.29が切れ目になっているとここでエラー発生の可能性があるが、現実的ではない

   

        wk_yyyy = rs.Fields("yyyy")

        If i >= 8 Then wk_yyyy = rs.Fields("yyyy") + 1

        tmp = DateValue(CStr(wk_yyyy) & "/" & rs.Fields("mm" & Format(i, "00")) & "/" & rs.Fields("dd" & Format(i, "00")))

       

        If i = 5 Then wk = wk & "夏休み:"

        If i = 7 Then wk = wk & "冬休み:"

        If i = 9 Then wk = wk & "春休み:"

       

        wk = wk & CStr(Month(tmp)) & "月" & CStr(Day(tmp)) & "日(" & WeekdayName(Weekday(tmp), True) & ")"

       

        If i = 5 Or i = 7 Or i = 9 Then

            wk = wk & " - "

        Else

            wk = wk & "    "

        End If

       

    Next i

   

    hidden_data2.Value = wk

   

    rs.Close

    Set rs = Nothing

    db.Close

    Set db = Nothing

   

End Sub

 

Private Sub matrix_title_dsp()

 

    header01.Value = "曜日"

    header02.Value = "前期回数"

    header03.Value = "後期回数"

 

    item01.Value = "月"

    item02.Value = "火"

    item03.Value = "水"

    item04.Value = "木"

    item05.Value = "金"

    item06.Value = "土"

   

    mae_cnt_mon.Value = 0

    mae_cnt_tue.Value = 0

    mae_cnt_wed.Value = 0

    mae_cnt_thu.Value = 0

    mae_cnt_fri.Value = 0

    mae_cnt_sat.Value = 0

   

    ato_cnt_mon.Value = 0

    ato_cnt_tue.Value = 0

    ato_cnt_wed.Value = 0

    ato_cnt_thu.Value = 0

    ato_cnt_fri.Value = 0

    ato_cnt_sat.Value = 0

 

End Sub

 

Private Sub setting_status_chk()

 

Dim db As DAO.Database

Dim rs As DAO.Recordset

Dim strSQL As String

Dim DayOfTheWeek As Integer

Dim mae_st_date, mae_en_date, ato_st_date, ato_en_date As Date

Dim cnt As Integer

 

    cnt = 0

 

    mae_st_date = DateValue(yyyy.Value & "/" & mm01.Value & "/" & dd01.Value)

    mae_en_date = DateValue(yyyy.Value & "/" & mm02.Value & "/" & dd02.Value)

    ato_st_date = DateValue(yyyy.Value & "/" & mm03.Value & "/" & dd03.Value)

    ato_en_date = DateValue(yyyy.Value & "/" & mm04.Value & "/" & dd04.Value)

   

    If mae_en_date < mae_st_date Then mae_en_date = DateAdd("yyyy", 1, mae_en_date)

    If ato_en_date < ato_st_date Then ato_en_date = DateAdd("yyyy", 1, ato_en_date)

 

    Set db = CurrentDb

    strSQL = "SELECT yyyymmdd FROM T_LECDAY_DEF WHERE nenndo=" & Val(yyyy.Value)

    strSQL = strSQL & " AND nense=" & Val(nense.Value) & ";"

    Set rs = db.OpenRecordset(strSQL)

  

    If rs.RecordCount > 0 Then mes_area2.Caption = "この年度の設定は完了していますが、再設定が出来ます。" _

    Else mes_area2.Caption = "この年度の設定は未完了です。"

   

    If rs.RecordCount > 0 Then rs.MoveFirst

   

    Do Until rs.EOF

   

        DayOfTheWeek = Weekday(rs.Fields("yyyymmdd"))

 

        If DateValue(rs.Fields("yyyymmdd")) >= DateValue(mae_st_date) _

                        And DateValue(rs.Fields("yyyymmdd")) <= DateValue(mae_en_date) Then

 

            If DayOfTheWeek = 2 Then mae_cnt_mon.Value = mae_cnt_mon.Value + 1

            If DayOfTheWeek = 3 Then mae_cnt_tue.Value = mae_cnt_tue.Value + 1

            If DayOfTheWeek = 4 Then mae_cnt_wed.Value = mae_cnt_wed.Value + 1

            If DayOfTheWeek = 5 Then mae_cnt_thu.Value = mae_cnt_thu.Value + 1

            If DayOfTheWeek = 6 Then mae_cnt_fri.Value = mae_cnt_fri.Value + 1

            If DayOfTheWeek = 7 Then mae_cnt_sat.Value = mae_cnt_sat.Value + 1

           

            cnt = cnt + 1

           

        End If

 

        If DateValue(rs.Fields("yyyymmdd")) >= DateValue(ato_st_date) _

                        And DateValue(rs.Fields("yyyymmdd")) <= DateValue(ato_en_date) Then

 

            If DayOfTheWeek = 2 Then ato_cnt_mon.Value = ato_cnt_mon.Value + 1

            If DayOfTheWeek = 3 Then ato_cnt_tue.Value = ato_cnt_tue.Value + 1

            If DayOfTheWeek = 4 Then ato_cnt_wed.Value = ato_cnt_wed.Value + 1

            If DayOfTheWeek = 5 Then ato_cnt_thu.Value = ato_cnt_thu.Value + 1

            If DayOfTheWeek = 6 Then ato_cnt_fri.Value = ato_cnt_fri.Value + 1

            If DayOfTheWeek = 7 Then ato_cnt_sat.Value = ato_cnt_sat.Value + 1

           

            cnt = cnt + 1

           

        End If

   

        rs.MoveNext

   

    Loop

 

    rs.Close

    Set rs = Nothing

    db.Close

    Set db = Nothing

   

    open_campas.Value = "全開校日数 : " & cnt

 

End Sub

 

Private Sub lecday_def_make()

 

Dim db As DAO.Database

Dim rs As DAO.Recordset

Dim strSQL As String

Dim ret, i As Integer

Dim st_date, en_date As Date

Dim do_flg As Boolean

Dim VaSumFr, VaSumTo, VaWinFr, VaWinTo, VaSprFr, VaSprTo As Date

 

    mes_area.Caption = "処理中"

    cmd_close.SetFocus

    cmd_start.Enabled = False

    cmd_ref_calen.Enabled = False

    cmd_to_holiday_def.Enabled = False

 

    Set db = CurrentDb

    strSQL = "SELECT * FROM T_LECDAY_DEF WHERE nenndo=" & Val(yyyy.Value) & " AND nense=" & Val(nense.Value) & ";"

    Set rs = db.OpenRecordset(strSQL)

  

    If rs.RecordCount > 0 Then

   

        If rs.EOF = False Then rs.MoveLast

        mes_area.Caption = "オペレータ指示待ち"

        ret = MsgBox(yyyy.Value & "年度の授業日が既に " & rs.RecordCount & " 日分設定済みです。" & vbCrLf _

                        & "新たに作成し直す時は「はい」を、処理を中止する時は「いいえ」をクリックして下さい。", vbYesNo)

        If ret = vbNo Then

            rs.Close

            Set rs = Nothing

            db.Close

            Set db = Nothing

            mes_area.Caption = "オペレータ指示により処理中止"

            cmd_start.Enabled = True

            cmd_ref_calen.Enabled = True

            cmd_to_holiday_def.Enabled = True

            cmd_start.SetFocus

           

            Exit Sub

        End If

 

        mes_area.Caption = "処理中"

        Me.Repaint

        strSQL = "DELETE * FROM T_LECDAY_DEF WHERE nenndo=" & Val(yyyy.Value) & " AND nense=" & Val(nense.Value) & ";"

        db.Execute strSQL

       

    End If

 

    VaSumFr = DateValue(yyyy.Value & "/" & mm05.Value & "/" & dd05.Value)

    VaSumTo = DateValue(yyyy.Value & "/" & mm06.Value & "/" & dd06.Value)

    VaWinFr = DateValue(yyyy.Value & "/" & mm07.Value & "/" & dd07.Value)

    VaWinTo = DateValue(yyyy.Value & "/" & mm08.Value & "/" & dd08.Value)

    VaSprFr = DateValue(yyyy.Value & "/" & mm09.Value & "/" & dd09.Value)

    VaSprTo = DateValue(yyyy.Value & "/" & mm10.Value & "/" & dd10.Value)

   

    If VaSumTo < VaSumFr Then VaSumTo = DateAdd("yyyy", 1, VaSumTo)

    If VaWinTo < VaWinFr Then VaWinTo = DateAdd("yyyy", 1, VaWinTo)

    If VaSprTo < VaSprFr Then VaSprTo = DateAdd("yyyy", 1, VaSprTo)

   

    For i = 0 To 1

   

        If i = 0 Then

            st_date = DateValue(yyyy.Value & "/" & mm01.Value & "/" & dd01.Value)

            en_date = DateValue(yyyy.Value & "/" & mm02.Value & "/" & dd02.Value)

        Else

            st_date = DateValue(yyyy.Value & "/" & mm03.Value & "/" & dd03.Value)

            en_date = DateValue(yyyy.Value & "/" & mm04.Value & "/" & dd04.Value)

        End If

       

        If en_date < st_date Then en_date = DateAdd("yyyy", 1, en_date)

 

        Do While st_date <= en_date

 

            strSQL = "SELECT * FROM T_LECDAY_DEF WHERE nenndo=" & Val(yyyy.Value) & " AND "

            strSQL = strSQL & "nense=" & Val(nense.Value) & " AND yyyymmdd=" & st_date & ";"

            Set rs = db.OpenRecordset(strSQL)

  

            If rs.RecordCount > 0 Then

   

                strSQL = "DELETE * FROM T_LECDAY_DEF WHERE nenndo=" & Val(yyyy.Value) & " AND "

                strSQL = strSQL & "nense=" & Val(nense.Value) & " AND yyyymmdd=" & st_date & ";"

           

            End If

           

            do_flg = True

            If Weekday(st_date) = 1 Then do_flg = False                                 '日曜日は無条件に休み

            If Weekday(st_date) = 7 And sat_chk.Value = False Then do_flg = False       '土曜休み設定校の場合

           

            If st_date >= VaSumFr And st_date <= VaSumTo Then do_flg = False            '夏季休暇の除外

            If st_date >= VaWinFr And st_date <= VaWinTo Then do_flg = False            '冬季休暇の除外

            If st_date >= VaSprFr And st_date <= VaSprTo Then do_flg = False            '春季休暇の除外

           

            strSQL = "SELECT * FROM T_HOLIDAY_DEF WHERE yyyymmdd=#" & st_date & "#;"    '祝祭日TBLに定義されている日の除外

            Set rs = db.OpenRecordset(strSQL)

            If rs.RecordCount > 0 Then do_flg = False

           

            If do_flg <> False Then

                strSQL = "INSERT INTO T_LECDAY_DEF(nenndo, nense, yyyymmdd, lecday_datetype, org_yyyymmdd, time_stamp) "

                strSQL = strSQL & "VALUES(" & Val(yyyy.Value) & ", " & Val(nense.Value)

                strSQL = strSQL & ", #" & st_date & "#, 0, #" & st_date & "#, #" & Now() & "#);"

 

                db.Execute strSQL

            End If

           

            st_date = DateAdd("d", 1, st_date)

 

        Loop

 

    Next i

 

    rs.Close

    Set rs = Nothing

    db.Close

    Set db = Nothing

   

    matrix_title_dsp

    setting_status_chk

    put_save_parameter

    hist_lst.Requery

 

    mes_area.Caption = "処理正常終了"

    cmd_start.Enabled = True

    cmd_ref_calen.Enabled = True

    cmd_to_holiday_def.Enabled = True

    cmd_start.SetFocus

   

    hist_lst.Value = -1

    cmd_hist_call.Enabled = False

   

End Sub

 

Private Sub cmd_close_Click()

 

    DoCmd.Close

    DoCmd.OpenForm ("F_MAIN_MENU")

 

End Sub

 

Private Sub cmd_detail_Click()

 

    DoCmd.OpenForm "F_LECDAY_DEF_DETAIL", acNormal, , , acFormEdit, acDialog

    matrix_title_dsp

    setting_status_chk

 

End Sub

 

Private Sub cmd_hist_call_Click()

 

    get_save_parameter ("CMD")

 

End Sub

 

Private Sub cmd_print_Click()

 

    print_tmp_file_init

    make_calender

    DoCmd.OpenReport "R_LECDAY_DEF", acViewPreview, , , acNormal

 

End Sub

 

Private Sub cmd_ref_calen_Click()

 

    DoCmd.OpenForm "F_CALENDER", acNormal, , , acFormEdit, acDialog

 

End Sub

 

Private Sub cmd_start_Click()

 

Dim tmp As Date

Dim error_field As Integer

 

On Error GoTo EXCEPTION_SECTION

 

    error_field = 1

    tmp = DateValue(yyyy.Value & "/" & mm01.Value & "/" & dd01.Value)

 

    error_field = 2

    tmp = DateValue(yyyy.Value & "/" & mm02.Value & "/" & dd02.Value)

 

    error_field = 3

    tmp = DateValue(yyyy.Value & "/" & mm03.Value & "/" & dd03.Value)

 

    error_field = 4

    tmp = DateValue(yyyy.Value & "/" & mm04.Value & "/" & dd04.Value)

   

On Error GoTo 0

 

    lecday_def_make

 

    Exit Sub

 

EXCEPTION_SECTION:

    tmp = MsgBox("年月日に妥当性がありません。", vbCritical, "DATE ERROR")

    If error_field = 1 Then mm01.SetFocus

    If error_field = 2 Then mm02.SetFocus

    If error_field = 3 Then mm03.SetFocus

    If error_field = 4 Then mm04.SetFocus

 

End Sub

 

Private Sub cmd_to_holiday_def_Click()

 

    DoCmd.OpenForm "F_HOLIDAY_DEF_UPD", acNormal, , , acFormEdit, acDialog

 

End Sub

 

Private Sub dd01_AfterUpdate()

 

    If mode_sw.Value = True Then change_first_stage

    chk_the_day_of_the_week

 

End Sub

 

Private Sub dd02_AfterUpdate()

 

    chk_the_day_of_the_week

 

End Sub

 

Private Sub dd03_AfterUpdate()

 

    chk_the_day_of_the_week

 

End Sub

 

Private Sub dd04_AfterUpdate()

 

    If mode_sw.Value = True Then change_second_stage

    chk_the_day_of_the_week

 

End Sub

 

Private Sub Form_Load()

 

Dim tmp As Date

 

    get_save_parameter ("AUTO")

 

    mes_area.Caption = "開校記念日、都民の日など例外的休日がある場合は祝祭日に設定して下さい。"

   

    matrix_title_dsp

    setting_status_chk

   

    cmd_hist_call.Enabled = False

   

    hist_lst.RowSource = "SELECT time_stamp, yyyy & '年度' AS yyyyy , nense & '年生' AS w_nense FROM T_LECDAY_PARAMETER_SAVE ORDER BY time_stamp DESC;"

    hist_lst.Requery

   

    mode_sw.Value = True

    Call set_mode_sw_forecolor(mode_sw.Value)

    mode_sw.Caption = set_mode_sw_caption(mode_sw.Value)

 

End Sub

 

Private Sub hist_lst_AfterUpdate()

 

    cmd_hist_call.Enabled = True

    cmd_hist_call.SetFocus

 

End Sub

 

Private Sub mm01_AfterUpdate()

 

    If mode_sw.Value = True Then change_first_stage

    chk_the_day_of_the_week

 

End Sub

 

Private Sub mm02_AfterUpdate()

 

    chk_the_day_of_the_week

 

End Sub

 

Private Sub mm03_AfterUpdate()

 

    chk_the_day_of_the_week

 

End Sub

 

Private Sub mm04_AfterUpdate()

 

    If mode_sw.Value = True Then change_second_stage

    chk_the_day_of_the_week

 

End Sub

 

Private Sub mode_sw_Click()

 

    Call set_mode_sw_forecolor(mode_sw.Value)

    mode_sw.Caption = set_mode_sw_caption(mode_sw.Value)

 

End Sub

 

Private Sub nense_AfterUpdate()

   

    matrix_title_dsp

    setting_status_chk

 

End Sub

 

Private Sub sat_chk_Click()

 

    sat_chk_mes.Value = boolean_message(sat_chk.Value)

 

End Sub