frmmark.frm

网上教务管理系统 包括（教师

Set ex = Nothing
End If
    
End Sub

Private Sub lstBJ_Click()
On Error GoTo 1
Dim sqlGrid As String
Dim recGrid As Recordset
Dim SQLFORXM As String
Dim recForXM As Recordset
Dim I As Integer
If Not IsNull(LSTBJ.List(LSTBJ.ListIndex)) Then
    sqlGrid = "select * from " + Trim(LSTBJ.List(LSTBJ.ListIndex)) + ""
    Set recGrid = DAT.OpenRecordset(sqlGrid, dbOpenSnapshot)
    Set Data1.Recordset = recGrid
    
'    DBGrid1.Columns(0).Width = 850
 '   DBGrid1.Columns(1).Width = 1700
  '  DBGrid1.Columns(2).Width = 1020
   ' DBGrid1.Columns(3).Width = 1250
    
    SQLFORXM = "select * from " + Trim(LSTBJ.List(LSTBJ.ListIndex)) + ""
    Set recForXM = DAT.OpenRecordset(SQLFORXM, dbOpenSnapshot)
    If recForXM.RecordCount <> 0 Then
        lstXM.Clear
        For I = 4 To recForXM.Fields.Count - 1
          lstXM.AddItem recForXM.Fields(I).Name
        Next I
    Else
        lstXM.Clear
        For I = 4 To recForXM.Fields.Count - 1
          lstXM.AddItem recForXM.Fields(I).Name
        Next I
        MsgBox "无成绩记录!", vbInformation, "信息提示框"
        
    End If
End If
Exit Sub
1:
MsgBox "无此班级", vbInformation, "信息提示框"
lstXM.Clear
Exit Sub
End Sub

Private Sub lstXM_Click()
'On Error Resume Next
Dim I As Integer
If Not IsNull(lstXM.List(LSTBJ.ListIndex)) Then
 
  For I = 0 To 7
    chkXQ(I).Enabled = True
  Next I
  Else
   MsgBox "无效姓名", vbInformation, "信息提示框"
End If
End Sub

Private Sub optYX_Click(Index As Integer)
'On Error Resume Next

Dim sqlForBJ As String
Dim recForBJ As Recordset
Dim I As Integer
If optYX(Index).Value = True Then
   
    sqlForBJ = "select distinct BANJMC  from BANJGL where YX='" + Trim(optYX(Index).Caption) + "'"
    Set recForBJ = DAT.OpenRecordset(sqlForBJ, dbOpenSnapshot)
    If recForBJ.RecordCount <> 0 Then
        recForBJ.MoveLast
        recForBJ.MoveFirst
        LSTBJ.Clear
        LSTBJ.AddItem recForBJ!BANJMC
        recForBJ.MoveNext
        For I = 1 To recForBJ.RecordCount - 1
          LSTBJ.AddItem recForBJ!BANJMC
          recForBJ.MoveNext
        Next I
    Else
        MsgBox "其中无此院系记录", vbInformation, "信息提示框"
        LSTBJ.Clear
        lstXM.Clear
    End If
End If
End Sub

'------------------------------------------------------------------------------------'
'过程:MakeArray( )
'入口参数:无
'出口参数:无
'设置XM(),Mark()
'------------------------------------------------------------------------------------'
Private Sub MakeArray()
On Error GoTo err
Dim QueryCount As Integer              '查询记号
Dim Query(1 To 8) As String            '查询条件数组
Dim D As Integer
Dim K As Integer
Dim L As Integer
Dim sqlForArray As String
Dim recForArray As Recordset

L = 1
QueryCount = 0

'设置查询数组 Query
For K = 0 To 7
  If chkXQ(K).Value = 1 Then
      QueryCount = QueryCount + 1
      Select Case K
      Case 0
        Query(L) = "1"
      Case 1
        Query(L) = "2"
      Case 2
        Query(L) = "3"
      Case 3
        Query(L) = "4"
      Case 4
        Query(L) = "5"
      Case 5
        Query(L) = "6"
      Case 6
        Query(L) = "7"
      Case 7
        Query(L) = "8"
      End Select
      L = L + 1
  End If
Next K


For D = 0 To lstXM.ListCount - 1
  
  '设置XM
  XM(D) = lstXM.List(D)
  '根据条件数编制条件语句并产生记录集
  Select Case QueryCount
    Case 0
      MsgBox "无选择条件", vbInformation
      Exit Sub
    Case 1
      sqlForArray = "select 课程名称,学分,学期," + Trim(lstXM.List(D)) + " from " + Trim(LSTBJ.List(LSTBJ.ListIndex)) + " where 学期='" + Trim(Query(1)) + "'"
    Case 2
      sqlForArray = "select 课程名称,学分,学期," + Trim(lstXM.List(D)) + " from " + Trim(LSTBJ.List(LSTBJ.ListIndex)) + " where 学期='" + Trim(Query(1)) + "' or 学期='" + Trim(Query(2)) + "'"
    Case 3
      sqlForArray = "select 课程名称,学分,学期," + Trim(lstXM.List(D)) + " from " + Trim(LSTBJ.List(LSTBJ.ListIndex)) + " where 学期='" + Trim(Query(1)) + "' or 学期='" + Trim(Query(2)) + "' or 学期='" + Trim(Query(3)) + "'"
    Case 4
      sqlForArray = "select 课程名称,学分,学期," + Trim(lstXM.List(D)) + " from " + Trim(LSTBJ.List(LSTBJ.ListIndex)) + " where 学期='" + Trim(Query(1)) + "' or 学期='" + Trim(Query(2)) + "' or 学期='" + Trim(Query(3)) + "' or 学期='" + Trim(Query(4)) + "'"
    Case 5
      sqlForArray = "select 课程名称,学分,学期," + Trim(lstXM.List(D)) + " from " + Trim(LSTBJ.List(LSTBJ.ListIndex)) + " where 学期='" + Trim(Query(1)) + "' or 学期='" + Trim(Query(2)) + "' or 学期='" + Trim(Query(3)) + "' or 学期='" + Trim(Query(4)) + "' or 学期='" + Trim(Query(5)) + "'"
    Case 6
      sqlForArray = "select 课程名称,学分,学期," + Trim(lstXM.List(D)) + " from " + Trim(LSTBJ.List(LSTBJ.ListIndex)) + " where 学期='" + Trim(Query(1)) + "' or 学期='" + Trim(Query(2)) + "' or 学期='" + Trim(Query(3)) + "' or 学期='" + Trim(Query(4)) + "' or 学期='" + Trim(Query(5)) + "' or 学期='" + Trim(Query(6)) + "'"
    Case 7
      sqlForArray = "select 课程名称,学分,学期," + Trim(lstXM.List(D)) + " from " + Trim(LSTBJ.List(LSTBJ.ListIndex)) + " where 学期='" + Trim(Query(1)) + "' or 学期='" + Trim(Query(2)) + "' or 学期='" + Trim(Query(3)) + "' or 学期='" + Trim(Query(4)) + "' or 学期='" + Trim(Query(5)) + "' or 学期='" + Trim(Query(6)) + "' or 学期='" + Trim(Query(7)) + "'"
    Case 8
      sqlForArray = "select 课程名称,学分,学期," + Trim(lstXM.List(D)) + " from " + Trim(LSTBJ.List(LSTBJ.ListIndex)) + " where 学期='" + Trim(Query(1)) + "' or 学期='" + Trim(Query(2)) + "' or 学期='" + Trim(Query(3)) + "' or 学期='" + Trim(Query(4)) + "' or 学期='" + Trim(Query(5)) + "' or 学期='" + Trim(Query(6)) + "' or 学期='" + Trim(Query(7)) + "' or 学期='" + Trim(Query(8)) + "'"
  End Select

  Set recForArray = DAT.OpenRecordset(sqlForArray, dbOpenSnapshot)

  '计算综合分
  Dim I As Integer
  Dim J As Integer
  Dim Sum As Double
  Dim XF As Double
  Dim txtone(0 To 60) As Double
  Dim TXTMARK(0 To 60) As Double
  J = 0
  If recForArray.RecordCount <> 0 Then
      recForArray.MoveLast
      recForArray.MoveFirst
      txtone(J) = recForArray.Fields(1)
      TXTMARK(J) = recForArray.Fields(3)
      J = J + 1
      For I = 1 To recForXM.RecordCount - 1
        recForArray.MoveNext
        txtone(J) = recForArray.Fields(1)
        TXTMARK(J) = recForArray.Fields(3)
        J = J + 1
      Next I
    
    
      Sum = 0
      XF = 0
      For I = 0 To 59
        If txtone(I) <> 0 Then
            Sum = Sum + TXTMARK(I) * txtone(I)
            XF = XF + txtone(I)
        End If
      Next I
      mark(D) = Sum / XF
      For I = 1 To 60
        txtone(I) = 0
        TXTMARK(I) = 0
      Next I
  End If
Next D
Exit Sub
err:
Resume Next
Exit Sub
End Sub
'冒泡排序
Private Sub PX()
'On Error Resume Next
Dim TempMark As Double
Dim TempXM As String
Dim I As Integer
Dim J As Integer
Dim N As Integer
'计算共有几个数据
N = 0
For I = 0 To 50
If IsNull(mark(I)) Then
Exit For
End If
  If mark(I) <> 0 Then
      N = N + 1
  Else
      Exit For
  End If
Next I
'冒泡排序
N = N - 1
While (N > 0)
  J = 0
  For I = 0 To N
    If mark(I) < mark(I + 1) Then
        TempMark = mark(I)
        mark(I) = mark(I + 1)
        mark(I + 1) = TempMark
        TempXM = XM(I)
        XM(I) = XM(I + 1)
        XM(I + 1) = TempXM
        J = I
    End If
  Next I
  N = J
Wend
End Sub

'合并数组
Private Sub Merge()
'On Error Resume Next
Dim I As Integer
Dim N As Integer
'计算共有几个数据
N = 0
For I = 0 To 50
  If mark(I) <> 0 Then
      N = N + 1
  Else
      Exit For
  End If
Next I
With frmMarkList.MS
  .Row = 0
  .col = 0
  .ColWidth(0) = 1400
  .Text = "名次"
  .col = 1
  .ColWidth(1) = 1400
  .Text = "姓名"
  .col = 2
  .ColWidth(2) = 1400
  .Text = "综合成绩"
  
  For I = 0 To N - 1
    .Row = I + 1
    .col = 0
    .ColWidth(0) = 1600
    .Text = "第" & CStr(I) + 1 & "名"
    .col = 1
    .ColWidth(1) = 1600
    .Text = XM(I)
    .col = 2
    .ColWidth(2) = 1600
    .Text = Left(mark(I), 7)
  Next I
End With

frmMarkList.Show 1
End Sub
Private Sub COMM()
'On Error GoTo ERR
Dim QueryCount As Integer              '查询记号
Dim Query(1 To 8) As String            '查询条件数组
Dim K As Integer
Dim L As Integer
Dim SQLFORXM As String
L = 1
QueryCount = 0

'设置查询数组 Query
For K = 0 To 7
  If chkXQ(K).Value = 1 Then
      QueryCount = QueryCount + 1
      Select Case K
      Case 0
        Query(L) = "1"
      Case 1
        Query(L) = "2"
      Case 2
        Query(L) = "3"
      Case 3
        Query(L) = "4"
      Case 4
        Query(L) = "5"
      Case 5
        Query(L) = "6"
      Case 6
        Query(L) = "7"
      Case 7
        Query(L) = "8"
      End Select
      L = L + 1
  End If
Next K

If lstXM.List(lstXM.ListIndex) = "" Then
    lstXM.ListIndex = 1
End If
'根据条件数编制条件语句并产生记录集
Select Case QueryCount
  Case 0
    MsgBox "无选择条件", vbInformation
    Exit Sub
  Case 1
    SQLFORXM = "select 课程名称,学分,学期," + Trim(lstXM.List(lstXM.ListIndex)) + " from " + Trim(LSTBJ.List(LSTBJ.ListIndex)) + " where 学期='" + Trim(Query(1)) + "'"
  Case 2
    SQLFORXM = "select 课程名称,学分,学期," + Trim(lstXM.List(lstXM.ListIndex)) + " from " + Trim(LSTBJ.List(LSTBJ.ListIndex)) + " where 学期='" + Trim(Query(1)) + "' or 学期='" + Trim(Query(2)) + "'"
  Case 3
    SQLFORXM = "select 课程名称,学分,学期," + Trim(lstXM.List(lstXM.ListIndex)) + " from " + Trim(LSTBJ.List(LSTBJ.ListIndex)) + " where 学期='" + Trim(Query(1)) + "' or 学期='" + Trim(Query(2)) + "' or 学期='" + Trim(Query(3)) + "'"
  Case 4
    SQLFORXM = "select 课程名称,学分,学期," + Trim(lstXM.List(lstXM.ListIndex)) + " from " + Trim(LSTBJ.List(LSTBJ.ListIndex)) + " where 学期='" + Trim(Query(1)) + "' or 学期='" + Trim(Query(2)) + "' or 学期='" + Trim(Query(3)) + "' or 学期='" + Trim(Query(4)) + "'"
  Case 5
    SQLFORXM = "select 课程名称,学分,学期," + Trim(lstXM.List(lstXM.ListIndex)) + " from " + Trim(LSTBJ.List(LSTBJ.ListIndex)) + " where 学期='" + Trim(Query(1)) + "' or 学期='" + Trim(Query(2)) + "' or 学期='" + Trim(Query(3)) + "' or 学期='" + Trim(Query(4)) + "' or 学期='" + Trim(Query(5)) + "'"
  Case 6
    SQLFORXM = "select 课程名称,学分,学期," + Trim(lstXM.List(lstXM.ListIndex)) + " from " + Trim(LSTBJ.List(LSTBJ.ListIndex)) + " where 学期='" + Trim(Query(1)) + "' or 学期='" + Trim(Query(2)) + "' or 学期='" + Trim(Query(3)) + "' or 学期='" + Trim(Query(4)) + "' or 学期='" + Trim(Query(5)) + "' or 学期='" + Trim(Query(6)) + "'"
  Case 7
    SQLFORXM = "select 课程名称,学分,学期," + Trim(lstXM.List(lstXM.ListIndex)) + " from " + Trim(LSTBJ.List(LSTBJ.ListIndex)) + " where 学期='" + Trim(Query(1)) + "' or 学期='" + Trim(Query(2)) + "' or 学期='" + Trim(Query(3)) + "' or 学期='" + Trim(Query(4)) + "' or 学期='" + Trim(Query(5)) + "' or 学期='" + Trim(Query(6)) + "' or 学期='" + Trim(Query(7)) + "'"
  Case 8
    SQLFORXM = "select 课程名称,学分,学期," + Trim(lstXM.List(lstXM.ListIndex)) + " from " + Trim(LSTBJ.List(LSTBJ.ListIndex)) + " where 学期='" + Trim(Query(1)) + "' or 学期='" + Trim(Query(2)) + "' or 学期='" + Trim(Query(3)) + "' or 学期='" + Trim(Query(4)) + "' or 学期='" + Trim(Query(5)) + "' or 学期='" + Trim(Query(6)) + "' or 学期='" + Trim(Query(7)) + "' or 学期='" + Trim(Query(8)) + "'"
End Select

Set recForXM = DAT.OpenRecordset(SQLFORXM, dbOpenSnapshot)
Set Data1.Recordset = recForXM

'计算综合分
Dim I As Integer
Dim J As Integer
Dim Sum As Double
Dim XF As Double
Dim txtone(0 To 60) As Double
Dim TXTMARK(0 To 60) As Double
J = 0
If recForXM.RecordCount <> 0 Then
    recForXM.MoveLast
    recForXM.MoveFirst
    txtone(J) = recForXM.Fields(1)
    TXTMARK(J) = recForXM.Fields(3)
    J = J + 1
    For I = 1 To recForXM.RecordCount - 1
      recForXM.MoveNext
        txtone(J) = recForXM.Fields(1)
        TXTMARK(J) = recForXM.Fields(3)
        J = J + 1
    Next I
    
    
    Sum = 0
    XF = 0
    For I = 0 To 60
      If txtone(I) <> 0 Then
          Sum = Sum + TXTMARK(I) * txtone(I)
          XF = XF + txtone(I)
      End If
    Next I
    txtZHF = Left(CStr(Sum / XF), 7)
End If

End Sub