FrmSelectedClass

Код:

Dim fld As Field

Dim rs As Recordset

Private Sub cmdExit_Click()

otv = MsgBox(" Высохранили сделанные изменения? ", vbQuestion + vbOKCancel, " SoftMaster")

If otv = vbOK Then

Unload Me

End If

End Sub

Private Sub cmdFind_Click()

On Error Resume Next

'поиска по началу фамилии

Dim famFind As String

famFind = InputBox(" Введите фамилию для поиска", _

" Поиск по фамилии")

Data1.Recordset.FindFirst " [Фамилия] like '" & famFind & " *'"

End Sub

Private Sub cmdZodiak_Click()

On Error GoTo eh

'определение знака зодиака

Dim Day As Date

Dim DayBegin As Date

Dim DayEnd As Date

Dim Znak As String

Znak = Text6(1)

'значение года ".85" - чистая фикция, он нужен только для

'сохранения формата даты

Day = CDate(Left$(Znak, 5) + ".85")

If Day > = CDate(" 21.3.85") And Day < = CDate(" 20.4.85") Then Text6(4) = " Овен"

If Day > = CDate(" 21.4.85") And Day < = CDate(" 20.5.85") Then Text6(4) = " Телец"

If Day > = CDate(" 21.5.85") And Day < = CDate(" 21.6.85") Then Text6(4) = " Близнецы"

If Day > = CDate(" 22.6.85") And Day < = CDate(" 22.7.85") Then Text6(4) = " Рак"

If Day > = CDate(" 23.7.85") And Day < = CDate(" 23.8.85") Then Text6(4) = " Лев"

If Day > = CDate(" 24.8.85") And Day < = CDate(" 23.9.85") Then Text6(4) = " Дева"

If Day > = CDate(" 24.9.85") And Day < = CDate(" 23.10.85") Then Text6(4) = " Весы"

If Day > = CDate(" 24.10.85") And Day < = CDate(" 22.11.85") Then Text6(4) = " Скорпион"

If Day > = CDate(" 23.11.85") And Day < = CDate(" 21.12.85") Then Text6(4) = " Стрелец"

If Day > = CDate(" 22.12.85") And Day < = CDate(" 20.1.85") Then Text6(4) = " Козерог"

If Day > = CDate(" 21.1.85") And Day < = CDate(" 19.2.85") Then Text6(4) = " Водолей"

If Day > = CDate(" 20.2.85") And Day < = CDate(" 20.3.85") Then Text6(4) = " Рыбы"

Exit Sub

eh:

If Err.Number = 13 Then

MsgBox " Введите дату рождения в виде ДД.ММ.ГГ", vbInformation, " Ошибка"

Text6(1).SetFocus

End If

End Sub

Private Sub Data1_Reposition()

'отражает номер текуще записи в Data

Data1.Caption = " № " & Data1.Recordset.AbsolutePosition + 1 & _

" из " & Data1.Recordset.RecordCount

'удаляет средние значения при переходе к другой записи

Call DelLabels

End Sub

Private Sub DeleteRec_Click()

On Error GoTo eh

ans = MsgBox(" Запись будет удалена совсем. Вы уверены? ", vbQuestion + vbOKCancel, " SoftMaster")

If ans = vbOK Then

With Data1.Recordset

.Delete

.MoveNext

If.EOF Then.MoveLast

End With

End If

Call DelLabels

Exit Sub

eh:

If Err.Number = 3021 Then MsgBox " Больше нет текущих записей", vbInformation, " База данных"

End Sub

Private Sub Form_Load()

frmParol.CenterForm Me

Me.Caption = " Выбранный класс - " & frmClasses.tbl.Name

Data1.RecordSource = frmClasses.tbl.Name

Text1.DataField = " Фамилия"

Text2.DataField = " Имя"

Text3.DataField = " Отчество"

'************ определяем количество предметов в классе *********

Dim Num As Integer

'количество предметов всего

Num = frmClasses.tbl.Fields.Count - 1

'номер первого предмета в таблице = 20(без ФИО и начальных для всех полей)

For i = 4 To 8

Set fld = frmClasses.tbl.Fields(i)

Text6(i - 4).DataField = fld.Name

Next i

For i = 12 To 19

Set fld = frmClasses.tbl.Fields(i)

Text5(i - 12).DataField = fld.Name

Next i

For i = 20 To Num

Set fld = frmClasses.tbl.Fields(i)

Label4(i - 20).Caption = fld.Name

Text4(i - 20).Visible = True

Метка1(i - 20).Visible = True

Text4(i - 20).DataField = fld.Name

Next i

Set fld = frmClasses.tbl.Fields(3)

Combo1.DataField = fld.Name

Set fld = frmClasses.tbl.Fields(9)

Combo2.DataField = fld.Name

Set fld = frmClasses.tbl.Fields(10)

Combo3.DataField = fld.Name

Set fld = frmClasses.tbl.Fields(11)

Text7.DataField = fld.Name

End Sub

Private Sub NewRec_Click()

Call DelLabels

Data1.Recordset.AddNew

End Sub

Private Sub Save_Click()

Data1.UpdateRecord

End Sub

Private Sub ShowAllStudents_Click()

frmAllStudents.Show

End Sub

Private Sub Text4_Change(Index As Integer)

'чтобы игнорировать деление на ноль

On Error Resume Next

'вычисление среднего значения

For i = 0 To 19

If Text4(i).DataChanged = True Then

If Text4(i) = " " Then Метка1(i) = " "

Метка1(i) = Summa(Text4(i)) / Len(Text4(i))

End If

Next

End Sub

Public Function Summa(T)

'сумма всех оценок

Dim sum As Integer

For i = 1 To Len(T)

sum = sum + Val(Mid$(T, i, 1))

Next

Summa = sum

End Function

Private Sub Text4_KeyPress(Index As Integer, KeyAscii As Integer)

'контроль ввода оценок (только оценки)

Select Case KeyAscii

'разрешить нажатие этих клавиш

Case Asc(" < ")

Case Asc(" > ")

Case Asc(Chr$(8)) 'это BackSpace

'запретить нажатие всех, кроме 1, 2, 3, 4, 5

Case Is < Asc(" 1")

KeyAscii = 0

Case Is > Asc(" 5")

KeyAscii = 0

End Select

End Sub

Public Sub DelLabels()

For i = 0 To 19

Метка1(i) = " "

Next i

End Sub

Private Sub Метка1_Click(Index As Integer)

'чтобы игнорировать деление на ноль

On Error Resume Next

For i = 0 To 19

If Text4(i).Visible = True Then

If Text4(i) = " " Then Метка1(i) = " "

Метка1(i) = Summa(Text4(i)) / Len(Text4(i))

End If

Next

End Sub