Разработка базы данных для ведения учета успеваемости студентов в электронном виде

    flxPlan.Rows = flxPlan.Rows + 1

    flxPlan.TextMatrix(flxPlan.Rows - 1, 0) = rsDis!IdDis

    flxPlan.TextMatrix(flxPlan.Rows - 1, 1) = rsDis!NameDis

    rsInPlan.MoveNext

    rsDis.Close

Next i

rsTyp.CursorLocation = adUseClient

rsTyp.Open "Select * from TypLesson", BDSt.cnnBDSt, adOpenDynamic, adLockOptimistic

While rsTyp.EOF = False

    flxPlan.Cols = flxPlan.Cols + 1

    flxPlan.TextMatrix(0, flxPlan.Cols - 1) = rsTyp!MiniNameTypLes

    flxPlan.ColWidth(flxPlan.Cols - 1) = 400

    If rsInPlan.RecordCount > 0 Then rsInPlan.MoveFirst

    For i = 1 To rsInPlan.RecordCount

        If GetHours(zzz, rsTyp!IdTypLes, rsInPlan!KodInPlan) > 0 Then flxPlan.TextMatrix(i, flxPlan.Cols - 1) = GetHours(zzz, rsTyp!IdTypLes, rsInPlan!KodInPlan)

        rsInPlan.MoveNext

    Next i

    rsTyp.MoveNext

Wend

End Sub 

Private Sub cmdAddDis_Click()

If Len(dcbDis.Text) = 0 Then Exit Sub

For i = 1 To flxPlan.Rows - 1

    If flxPlan.TextMatrix(i, 1) = dcbDis.Text Then

        MsgBox "Дисциплина уже добавлена.", vbInformation, App.Title

        Exit Sub

    End If

Next i

flxPlan.Rows = flxPlan.Rows + 1

flxPlan.TextMatrix(flxPlan.Rows - 1, 1) = dcbDis.Text

flxPlan.TextMatrix(flxPlan.Rows - 1, 0) = dcbDis.BoundText

cmdSave.Enabled = False

End Sub 

Private Sub cmdCalc_Click()

For i = 2 To flxPlan.Cols - 1

    For k = 1 To flxPlan.Rows - 1

        If flxPlan.TextMatrix(k, i) = "" Then flxPlan.TextMatrix(k, i) = "0"

    Next k

Next i

flxPlan.Cols = flxPlan.Cols + 3

flxPlan.TextMatrix(0, flxPlan.Cols - 3) = "Всего лк"

flxPlan.TextMatrix(0, flxPlan.Cols - 2) = "Всего пр"

flxPlan.TextMatrix(0, flxPlan.Cols - 1) = "Всего лр"

cmdSave.Enabled = True

cmdCalc.Enabled = False

End Sub 

Private Sub cmdExit_Click()

Unload Me

End Sub 

Private Sub cmdRem_Click()

If flxPlan.Rows < 2 Then Exit Sub

For i = flxPlan.Row To flxPlan.Rows - 2

    For k = 0 To flxPlan.Cols - 1

        flxPlan.TextMatrix(i, k) = flxPlan.TextMatrix(i + 1, k)

    Next k

Next i

flxPlan.Rows = flxPlan.Rows - 1

cmdSave.Enabled = False

End Sub 

Private Sub cmdSave_Click()

Dim MMSg As Integer

MMSg = MsgBox("     Сохранить изменения?" & Chr(10) & Chr(13) & "Откат изменений невозможен.", vbQuestion + vbOKCancel, App.Title)

If MMSg = vbOK Then

Dim rsInPlan As New Recordset

Dim rsOnHour As New Recordset

Dim rsTypLes As New Recordset

Dim TLBool As Boolean

If opt1.Value = True Then TLBool = True Else TLBool = False

For i = 1 To flxPlan.Rows - 1

    'поиск в содержимом плана

    'если  дисциплины нет, то она добавляется  к плану

    rsInPlan.CursorLocation = adUseClient

    rsInPlan.Open "Select * from InPlan where IdDis=" & flxPlan.TextMatrix(i, 0) & " and IdPlan=" & BDSt.rsPlan!IdPlan, BDSt.cnnBDSt, adOpenDynamic, adLockOptimistic

    If rsInPlan.RecordCount = 0 Then

        BDSt.cnnBDSt.Execute "Insert into InPlan (IdPlan,IdDis) select " & BDSt.rsPlan!IdPlan & ", " & flxPlan.TextMatrix(i, 0)

        rsInPlan.Close

        rsInPlan.Open "Select * from InPlan where IdDis=" & flxPlan.TextMatrix(i, 0) & " and IdPlan=" & BDSt.rsPlan!IdPlan, BDSt.cnnBDSt, adOpenDynamic, adLockOptimistic

    End If

    rsTypLes.CursorLocation = adUseClient

    rsTypLes.Open "Select * from TypLesson", BDSt.cnnBDSt, adOpenDynamic, adLockOptimistic

    For k = 2 To flxPlan.Cols - 4

        rsOnHour.CursorLocation = adUseClient

        rsOnHour.Open "Select * from OnHour where IdTypLes=" & rsTypLes!IdTypLes & " and IdInPlan=" & rsInPlan!KodInPlan & " and Semestr=" & TLBool, BDSt.cnnBDSt, adOpenDynamic, adLockOptimistic

        If rsOnHour.RecordCount = 0 Then

            If flxPlan.TextMatrix(i, k) > 0 Then BDSt.cnnBDSt.Execute "Insert into OnHour (Semestr,IdTypLes,IdInPlan,Hours) select " & TLBool & ", " & rsTypLes!IdTypLes & ", " & rsInPlan!KodInPlan & ", " & flxPlan.TextMatrix(i, k)

        Else

            If flxPlan.TextMatrix(i, k) <> rsOnHour!Hours Then

                If flxPlan.TextMatrix(i, k) = 0 Then

                    BDSt.cnnBDSt.Execute "DELETE from OnHour WHERE (Semestr = " & TLBool & ") AND (IdTypLes = " & rsTypLes!IdTypLes & ") AND (IdInPlan = " & rsInPlan!KodInPlan & ")"

                Else

                    BDSt.cnnBDSt.Execute "UPDATE OnHour SET Hours = " & flxPlan.TextMatrix(i, k) & " WHERE (Semestr = " & TLBool & ") AND (IdTypLes = " & rsTypLes!IdTypLes & ") AND (IdInPlan = " & rsInPlan!KodInPlan & ")"

                End If

            End If

        End If

        rsOnHour.Close

        If rsTypLes.EOF = False Then rsTypLes.MoveNext

    Next k

    rsInPlan.Close

    rsTypLes.Close

Next i

cmdCalc.Enabled = True

cmdSave.Enabled = False

flxPlan.Cols = flxPlan.Cols - 3

Else

    cmdCalc.Enabled = False

End If

End Sub

Private Sub flxPlan_KeyPress(KeyAscii As Integer)

If flxPlan.Rows = 1 Then Exit Sub

Select Case KeyAscii

Case 48 To 57

    flxPlan.Text = flxPlan.Text & Chr(KeyAscii)

    cmdSave.Enabled = False

Case 8

    If Len(flxPlan.Text) > 0 Then flxPlan.Text = Mid(flxPlan.Text, 1, Len(flxPlan.Text) - 1)

    cmdSave.Enabled = False

End Select

End Sub 

Private Sub Form_Load()

OpenRec (True)

flxPlan.ColWidth(0) = 0

flxPlan.ColWidth(1) = 3000

End Sub 

Private Sub opt1_Click()

flxPlan.Rows = 1

flxPlan.Cols = 2

OpenRec (True)

cmdCalc.Enabled = True

cmdSave.Enabled = False

End Sub 

Private Sub opt2_Click()

flxPlan.Rows = 1

flxPlan.Cols = 2

OpenRec (False)

cmdCalc.Enabled = True

cmdSave.Enabled = False

End Sub  

Форма для распределения нагрузки.

    Форма представляет собой рабочий план. Здесь можно выбрать дисциплину и тип занятий. После этого  можно открыть форму со списком  преподавателей и свободных групп.

Рисунок 5. Форма “Распределение нагрузки”

Код формы:

Private Sub LoadNagr()

Dim rsPlanAll As New Recordset

Dim Sql As String

Dim Semestr As Boolean

flxNagr.Cols = 1

flxNagr.Rows = 1

If opt1.Value = True Then Semestr = True Else Semestr = False

rsPlanAll.CursorLocation = adUseClient

Sql = "TRANSFORM Sum(vPlanForPer.Hours) AS [Sum-Hours] " & _

"SELECT vPlanForPer.IdPlan, vPlanForPer.NameDis as [Дисциплина], vPlanForPer.IdDis, Sum(vPlanForPer.Hours) AS Всего " & _

"From vPlanForPer WHERE vPlanForPer.IdPlan= " & _

BDSt.rsPlan!IdPlan & " and vPlanForPer.Semestr=" & Semestr & " " & _

"GROUP BY vPlanForPer.IdPlan, vPlanForPer.NameDis, vPlanForPer.IdDis" & _

"PIVOT vPlanForPer.MiniNameTypLes"

rsPlanAll.Open Sql, BDSt.cnnBDSt, adOpenDynamic, adLockOptimistic

flxNagr.Cols = rsPlanAll.Fields.Count

flxNagr.ColWidth(0) = 0

flxNagr.ColWidth(1) = 4000

flxNagr.ColWidth(2) = 0

flxNagr.ColWidth(3) = 600

For i = 4 To flxNagr.Cols - 1

    flxNagr.ColWidth(i) = 370

Next i

For i = 0 To rsPlanAll.Fields.Count - 1

    flxNagr.TextMatrix(0, i) = rsPlanAll.Fields(i).Name

Next i

For i = 1 To rsPlanAll.RecordCount

    flxNagr.Rows = flxNagr.Rows + 1

    For k = 0 To rsPlanAll.Fields.Count - 1

        If IsNull(rsPlanAll.Fields(k).Value) = False Then flxNagr.TextMatrix(i, k) = rsPlanAll.Fields(k).Value

    Next k

    If rsPlanAll.EOF = False Then rsPlanAll.MoveNext

Next i

rsPlanAll.Close

End Sub 

Private Sub cmdAdd_Click()

flxNagr_DblClick

End Sub 
 
 

Private Sub cmdCreateRes_Click()

CreateResult

End Sub 

Private Sub flxNagr_Click()

If (flxNagr.Col > 4) And (flxNagr.Row > 0) Then

    Dim rsType As New Recordset

    Dim Sql As String

    Sql = "Select * from TypLesson where MiniNameTypLes=" & Chr(39) & flxNagr.TextMatrix(0, flxNagr.Col) & Chr(39)

    rsType.CursorLocation = adUseClient

    rsType.Open Sql, BDSt.cnnBDSt, adOpenDynamic, adLockOptimistic

    lblDis.Caption = flxNagr.TextMatrix(flxNagr.Row, 1)

    If rsType.RecordCount > 0 Then

        lblType.Caption = rsType!NameTypLes

        IdTypeLesForNagr = rsType!IdTypLes

    End If

    If Len(flxNagr.Text) > 0 Then lblHour.Caption = flxNagr.Text Else lblHour.Caption = "0"

    rsType.Close

Else

    lblType.Caption = ""

    lblDis.Caption = ""

    lblHour = ""

End If

End Sub 

Private Sub flxNagr_DblClick()

If Val(lblHour.Caption) > 0 Then

    frmTeacher.Show vbModal

End If

End Sub 

Private Sub Form_Load()

LoadNagr

    lblType.Caption = ""

    lblDis.Caption = ""

    lblHour = ""

End Sub 

Private Sub opt1_Click()

LoadNagr

    lblType.Caption = ""

    lblDis.Caption = ""

    lblHour = ""

End Sub 

Private Sub opt2_Click()

LoadNagr

    lblType.Caption = ""

    lblDis.Caption = ""

    lblHour = ""

End Sub

Рисунок 6. Форма для выбора преподавателей и группы.

Код формы:

Private Sub cmdExit_Click()

    Unload Me

End Sub

Private Sub cmdSave_Click()

If flxFreeGr.Rows > 1 Then

If (Len(dcbTeach.BoundText) <> 0) And (flxFreeGr.TextMatrix(flxFreeGr.Row, flxFreeGr.Col) = "Свободна") Then

    Dim sqlInsert As String

    Dim sqlIdRazb As String

    Dim rsIdRazb As New Recordset

    Dim NumIdRazb As Long

    sqlIdRazb = "SELECT OnHour.IdRazb FROM InPlan RIGHT JOIN " & _

    "OnHour ON InPlan.KodInPlan = OnHour.IdInPlan " & _

    "WHERE InPlan.IdPlan=" & BDSt.rsPlan!IdPlan & " AND " & _

    "InPlan.IdDis=" & frmNagr.flxNagr.TextMatrix(frmNagr.flxNagr.Row, 2) & " AND " & _

    "OnHour.Semestr=" & frmNagr.opt1.Value & " AND " & _

    "OnHour.IdTypLes=" & IdTypeLesForNagr

    rsIdRazb.CursorLocation = adUseClient

    rsIdRazb.Open sqlIdRazb, BDSt.cnnBDSt, adOpenDynamic, adLockOptimistic

    If rsIdRazb.RecordCount > 0 Then NumIdRazb = rsIdRazb!IdRazb

    rsIdRazb.Close

    sqlInsert = "INSERT INTO Nagruz ( IdTeach, IdRazb, IdGroup ) VALUES (" & dcbTeach.BoundText & ", " & NumIdRazb & ", " & IdGrForTeacher & ")"

    BDSt.cnnBDSt.Execute sqlInsert