frmccount.frm

一个数据库软件

      AutoSize        =   -1  'True
      Caption         =   "优秀率"
      ForeColor       =   &H00C00000&
      Height          =   180
      Left            =   4320
      TabIndex        =   114
      Top             =   480
      Width           =   540
   End
   Begin VB.Label Label16 
      AutoSize        =   -1  'True
      Caption         =   "优秀数"
      ForeColor       =   &H00C00000&
      Height          =   180
      Left            =   3525
      TabIndex        =   113
      Top             =   480
      Width           =   540
   End
   Begin VB.Label Label15 
      AutoSize        =   -1  'True
      Caption         =   "及格率"
      ForeColor       =   &H00C00000&
      Height          =   180
      Left            =   2655
      TabIndex        =   112
      Top             =   480
      Width           =   540
   End
   Begin VB.Label Label14 
      AutoSize        =   -1  'True
      Caption         =   "及格数"
      ForeColor       =   &H00C00000&
      Height          =   180
      Left            =   1845
      TabIndex        =   111
      Top             =   480
      Width           =   540
   End
   Begin VB.Label Label13 
      AutoSize        =   -1  'True
      Caption         =   "卷面总分"
      ForeColor       =   &H00800080&
      Height          =   180
      Left            =   1005
      TabIndex        =   110
      Top             =   480
      Width           =   720
   End
   Begin VB.Label Label12 
      AutoSize        =   -1  'True
      Caption         =   "学科"
      ForeColor       =   &H00C00000&
      Height          =   180
      Left            =   495
      TabIndex        =   109
      Top             =   480
      Width           =   360
   End
   Begin VB.Label labXk 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "生物"
      ForeColor       =   &H00008000&
      Height          =   180
      Index           =   8
      Left            =   480
      TabIndex        =   108
      Top             =   3240
      Width           =   360
   End
   Begin VB.Label labXk 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "地理"
      ForeColor       =   &H00008000&
      Height          =   180
      Index           =   7
      Left            =   480
      TabIndex        =   107
      Top             =   2955
      Width           =   360
   End
   Begin VB.Label labXk 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "历史"
      ForeColor       =   &H00008000&
      Height          =   180
      Index           =   6
      Left            =   480
      TabIndex        =   106
      Top             =   2655
      Width           =   360
   End
   Begin VB.Label labXk 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "政治"
      ForeColor       =   &H00008000&
      Height          =   180
      Index           =   5
      Left            =   480
      TabIndex        =   105
      Top             =   2355
      Width           =   360
   End
   Begin VB.Label labXk 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "化学"
      ForeColor       =   &H00008000&
      Height          =   180
      Index           =   4
      Left            =   480
      TabIndex        =   104
      Top             =   2055
      Width           =   360
   End
   Begin VB.Label labXk 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "物理"
      ForeColor       =   &H00008000&
      Height          =   180
      Index           =   3
      Left            =   480
      TabIndex        =   103
      Top             =   1755
      Width           =   360
   End
   Begin VB.Label labXk 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "英语"
      ForeColor       =   &H00008000&
      Height          =   180
      Index           =   2
      Left            =   480
      TabIndex        =   102
      Top             =   1455
      Width           =   360
   End
   Begin VB.Label labXk 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "数学"
      ForeColor       =   &H00008000&
      Height          =   180
      Index           =   1
      Left            =   480
      TabIndex        =   101
      Top             =   1155
      Width           =   360
   End
   Begin VB.Label labXk 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "语文"
      ForeColor       =   &H00008000&
      Height          =   180
      Index           =   0
      Left            =   480
      TabIndex        =   100
      Top             =   840
      Width           =   360
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "在籍数"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000080&
      Height          =   240
      Left            =   2760
      TabIndex        =   99
      Top             =   120
      Width           =   780
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "班级"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000000FF&
      Height          =   240
      Index           =   0
      Left            =   480
      TabIndex        =   98
      Top             =   120
      Width           =   525
   End
   Begin VB.Label Label4 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "计外"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000080&
      Height          =   240
      Left            =   4680
      TabIndex        =   97
      Top             =   120
      Width           =   525
   End
End
Attribute VB_Name = "FrmCCount"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim RSCount As ADODB.Recordset
Dim CmdExec As ADODB.Command
Dim i As Integer
Dim Jwsf As String
Dim AddFlg As Boolean

Private Sub Combo1_LostFocus()
On Error GoTo err
Dim ctl As Control
For Each ctl In Controls
   If TypeOf ctl Is TextBox Then
      ctl.Text = "0"
   End If
Next ctl
If Combo1.ListIndex = -1 Then
   Exit Sub
Else
   RSCount.Open "select distinct a.考试性质 as ksxz from 成绩表 AS a INNER JOIN 学籍表 AS b ON a.考试号 = b.考试号 Where b.班级 Like " & Combo1.Text, Con, adOpenStatic, , adCmdText
   Combo2.Clear
   Text1.Text = ""
   Combo2.Text = "请选择性质"
   Combo2.Enabled = False
   If RSCount.EOF = False And RSCount.BOF = False Then
      RSCount.MoveFirst
   Do While RSCount.EOF = False
      Combo2.AddItem RSCount!Ksxz
      RSCount.MoveNext
      Combo2.Enabled = True
   Loop
   End If
   RSCount.Close
End If
Exit Sub
err:
Call ExecErr(Date, Me.Caption, err.Number, err.Source, err.Description)
End Sub

Private Sub Command1_Click()
On Error GoTo wrong

If Combo1.ListIndex = -1 Or Combo2.ListIndex = -1 Or Text1.Text = "" Then
   MsgBox "统计需要项目未完整提供！"
   Exit Sub

End If
If Combo3.ListIndex = -1 And (Combo3.Text <> "否" And Combo3.Text <> "是") Then
       MsgBox "计外生情况描述不完整！"
       Exit Sub
  Else
   If Combo3.Text = "否" Then
   
   Else

   End If
End If

txtZf(9).Text = ""
txtZf(9).Text = txtZf(0).Text * 1 + txtZf(1).Text * 1 + txtZf(2).Text * 1 + txtZf(3).Text * 1 + txtZf(4).Text * 1 + txtZf(5).Text * 1 + txtZf(6).Text * 1 + txtZf(7).Text * 1 + txtZf(8).Text * 1

If Combo3.Text = "否" Then

    For i = 0 To 9
       If txtZf(i).Text <> 0 Then
    RSCount.Open "select count(*) as ywj from 成绩表 AS a INNER JOIN 学籍表 AS b ON a.考试号 = b.考试号 where b.计外 = '" & Combo3.Text & "' and b.班级 like " & Combo1.Text & " and a.考试性质 = '" & Combo2.Text & "' and a." & labXk(i).Caption & " >= " & txtZf(i).Text * 0.6, Con, adOpenStatic, , adCmdText
    txtZf(10 + i).Text = RSCount!ywj
    txtZf(20 + i).Text = RSCount!ywj / Text1.Text * 100
    RSCount.Close
    RSCount.Open "select count(*) as ywy from 成绩表 AS a INNER JOIN 学籍表 AS b ON a.考试号 = b.考试号 where b.计外 = '" & Combo3.Text & "' and b.班级 like " & Combo1.Text & " and a.考试性质 = '" & Combo2.Text & "' and a." & labXk(i).Caption & ">=" & txtZf(i).Text * 0.85, Con, adOpenStatic, , adCmdText
    txtZf(30 + i).Text = RSCount!ywy
    txtZf(40 + i).Text = RSCount!ywy / Text1.Text * 100
    RSCount.Close
    RSCount.Open "select sum(" & labXk(i).Caption & ") as ywz , count(*) as rs from 成绩表 AS a INNER JOIN 学籍表 AS b ON a.考试号 = b.考试号 where b.计外 = '" & Combo3.Text & "' and b.班级 like " & Combo1.Text & " and a.考试性质 = '" & Combo2.Text & "'", Con, adOpenStatic, , adCmdText
    txtZf(50 + i).Text = RSCount!ywz
    txtZf(60 + i).Text = RSCount!ywz / Text1.Text
    txtZf(70 + i).Text = txtZf(20 + i).Text * 0.4 + txtZf(40 + i).Text * 0.2 + txtZf(60 + i).Text * 0.4
    txtZf(80 + i).Text = RSCount!rs
    RSCount.Close
       End If
    Next i

End If
If Combo3.Text = "是" Then

    For i = 0 To 9
       If txtZf(i).Text <> 0 Then
    RSCount.Open "select count(*) as ywj from 成绩表 AS a INNER JOIN 学籍表 AS b ON a.考试号 = b.考试号 where b.班级 like " & Combo1.Text & " and a.考试性质 = '" & Combo2.Text & "' and a." & labXk(i).Caption & " >= " & txtZf(i).Text * 0.6, Con, adOpenStatic, , adCmdText
    txtZf(10 + i).Text = RSCount!ywj
    txtZf(20 + i).Text = RSCount!ywj / Text1.Text * 100
    RSCount.Close
    RSCount.Open "select count(*) as ywy from 成绩表 AS a INNER JOIN 学籍表 AS b ON a.考试号 = b.考试号 where b.班级 like " & Combo1.Text & " and a.考试性质 = '" & Combo2.Text & "' and a." & labXk(i).Caption & ">=" & txtZf(i).Text * 0.85, Con, adOpenStatic, , adCmdText
    txtZf(30 + i).Text = RSCount!ywy
    txtZf(40 + i).Text = RSCount!ywy / Text1.Text * 100
    RSCount.Close
    RSCount.Open "select sum(" & labXk(i).Caption & ") as ywz , count(*) as rs from 成绩表 AS a INNER JOIN 学籍表 AS b ON a.考试号 = b.考试号 where  b.班级 like " & Combo1.Text & " and a.考试性质 = '" & Combo2.Text & "'", Con, adOpenStatic, , adCmdText
    txtZf(50 + i).Text = RSCount!ywz
    txtZf(60 + i).Text = RSCount!ywz / Text1.Text
    txtZf(70 + i).Text = txtZf(20 + i).Text * 0.4 + txtZf(40 + i).Text * 0.2 + txtZf(60 + i).Text * 0.4
    txtZf(80 + i).Text = RSCount!rs
    RSCount.Close
       End If
    Next i

End If

Command3.Enabled = True
Exit Sub

wrong:
If err.Number = 3705 Then
   RSCount.Close
  MsgBox "内部错误，请重新按一下“统计”按钮！"
   Exit Sub
End If
MsgBox err.Number & err.Description & "，请检查您的初始值"
Call ExecErr(Date, Me.Caption, err.Number, err.Source, err.Description)
Dim ctl As Control
For Each ctl In Controls
   If TypeOf ctl Is TextBox Then
      ctl.Text = "0"
   End If
Next ctl

End Sub

Private Sub Command2_Click()
Unload Me
End Sub

Private Sub Command3_Click()
On Error GoTo err
Set CmdExec = New ADODB.Command
CmdExec.ActiveConnection = Con
Dim SqlString As String
For i = 0 To 9
    If txtZf(i).Text <> 0 Then
       SqlString = "insert into 考核表(班级,在籍数,计外,考试性质,学科,卷面总分,及格数,及格率,优秀数,优秀率,总分,均分,[442],参考数) values " & "(" & Combo1.Text & "," & Text1.Text & ",'" & Combo3.Text & "','" & Combo2.Text & "','" & labXk(i).Caption & "'," & txtZf(i).Text & "," & txtZf(i + 10).Text & "," & txtZf(i + 20).Text & "," & txtZf(i + 30).Text & "," & txtZf(i + 40).Text & "," & txtZf(i + 50).Text & "," & txtZf(i + 60).Text & ",'" & txtZf(i + 70).Text & "'," & txtZf(i + 80).Text & ")"
       CmdExec.CommandText = SqlString
       CmdExec.Execute
    End If
    Command3.Enabled = False
Next i
    MsgBox "添加存储成功！"
Exit Sub
err:
MsgBox "存储错误！"
Call ExecErr(Date, Me.Caption, err.Number, err.Source, err.Description)
End Sub

Private Sub Form_Load()
Call ResizeInit(Me)
Set RSCount = New ADODB.Recordset

Dim rsbj As ADODB.Recordset
Set rsbj = New ADODB.Recordset
rsbj.Open "班级表", Con, adOpenStatic, adLockPessimistic, adCmdTable
    Combo1.Clear
    Combo1.Text = "请选择..."
    Do While Not rsbj.EOF
        Combo1.AddItem rsbj!班级
        rsbj.MoveNext
    Loop
If Permission > 0 Then Command3.Visible = False
End Sub

Private Sub Form_Resize()
Call ResizeForm(Me) '窗体改变时，控件随之变化
With Combo1
  .Top = Label1(0).Top
  .Left = Label13.Left
  .Width = Label14.Width + Label13.Width
End With

With Combo3
  .Top = Label4.Top
  .Left = Label18.Left
  .Width = txtZf(50).Width
End With
With Combo2
  .Top = Label21.Top
  .Left = Label3.Left
  .Width = txtZf(70).Width + txtZf(80).Width
End With
Text1.Height = Combo1.Height
End Sub

Private Sub TabStrip1_Click()

End Sub

Private Sub txtZf_KeyPress(Index As Integer, KeyAscii As Integer)
If Not IsNumeric(Chr(KeyAscii)) Then
   KeyAscii = 0
End If
End Sub