frmcj2.frm

从别处拿来感觉还可以 内容比较多且完备值得大家看一看

            Index           =   5
            Left            =   3480
            TabIndex        =   20
            Top             =   1080
            Visible         =   0   'False
            Width           =   735
         End
         Begin VB.Label Label1 
            Caption         =   "语文："
            Height          =   255
            Index           =   4
            Left            =   240
            TabIndex        =   19
            Top             =   1080
            Visible         =   0   'False
            Width           =   735
         End
         Begin VB.Label Label1 
            Caption         =   "语文："
            Height          =   255
            Index           =   3
            Left            =   3480
            TabIndex        =   18
            Top             =   720
            Visible         =   0   'False
            Width           =   735
         End
         Begin VB.Label Label1 
            Caption         =   "语文："
            Height          =   255
            Index           =   2
            Left            =   240
            TabIndex        =   17
            Top             =   720
            Visible         =   0   'False
            Width           =   735
         End
         Begin VB.Label Label1 
            Caption         =   "语文："
            Height          =   255
            Index           =   1
            Left            =   3480
            TabIndex        =   16
            Top             =   360
            Visible         =   0   'False
            Width           =   735
         End
      End
      Begin VB.Label Label4 
         Caption         =   "学期："
         Height          =   255
         Left            =   840
         TabIndex        =   42
         Top             =   525
         Width           =   615
      End
      Begin VB.Label Label3 
         Caption         =   "班级："
         Height          =   255
         Left            =   840
         TabIndex        =   41
         Top             =   885
         Width           =   615
      End
      Begin VB.Label Label2 
         Caption         =   "学号："
         Height          =   255
         Left            =   840
         TabIndex        =   40
         Top             =   1230
         Width           =   615
      End
      Begin VB.Label Label5 
         Caption         =   "类型："
         Height          =   255
         Left            =   3960
         TabIndex        =   34
         Top             =   885
         Width           =   615
      End
      Begin VB.Label Label7 
         Caption         =   "姓名："
         Height          =   255
         Left            =   3960
         TabIndex        =   33
         Top             =   1245
         Width           =   615
      End
   End
   Begin VB.Label Label6 
      Caption         =   "成绩添加"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   21.75
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00C00000&
      Height          =   495
      Left            =   2400
      TabIndex        =   29
      Top             =   120
      Width           =   2055
   End
End
Attribute VB_Name = "frmcj2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim gg As Integer
Dim kechengcount As Integer
Public aaa As Boolean
Private Sub Combo1_Click()
    If Combo2.Text = "" Or Combo1.Text = "" Then
        Exit Sub
    End If
    fillkencheng
End Sub
Private Sub Combo2_Click()
    Dim mrc As ADODB.Recordset
    txtsql = "select  DISTINCT 学号  from xj where 班级='" & _
        Trim(Combo2.Text) & "' order by 学号"
    Set mrc = ExecuteSQL(txtsql)
    If mrc.EOF = True Then
        Combo4.Clear
        Text2.Text = ""
    Else
        mrc.MoveFirst
        Combo4.Clear
        Do While Not mrc.EOF
            Combo4.AddItem mrc.Fields(0)
            mrc.MoveNext
        Loop
        Combo4.ListIndex = 0
        Set mrc = Nothing
    End If
    If Combo2.Text = "" Or Combo1.Text = "" Then
        Exit Sub
    End If
    fillkencheng
End Sub
Private Sub Combo4_Change()
    If Trim(Combo4.Text) = "" Then
        List1.Clear
        List1.Visible = False
        Exit Sub
    End If
    If aaa = True Then
        List1.Clear
        List1.Visible = False
        Dim mrc As ADODB.Recordset
        txtsql = "select   DISTINCT 姓名 from xj where 学号 ='" & _
            Trim(Combo4.Text) & "'"
        Set mrc = ExecuteSQL(txtsql)
        If mrc.EOF = True Then
            sss = MsgBox("没有此学号！", vbExclamation + vbOKOnly, "警告")
            Text2.Text = ""
            Exit Sub
        End If
        Text2.Text = mrc.Fields(0)
        Set mrc = Nothing
        Exit Sub
    End If
    Dim rst As ADODB.Recordset
    Dim str As String
    str = "select 学号 from xj where 学号 like'" & Trim(Combo4.Text) & _
        "%' and 班级='" & Trim(Combo2.Text) & "' order by 学号"
    Set rst = ExecuteSQL(str)
    If rst.EOF = True Then
        List1.Clear
        List1.Visible = False
        Set rst = Nothing
        Exit Sub
    End If
    List1.Clear
    Do Until rst.EOF
        List1.AddItem rst.Fields(0)
        rst.MoveNext
    Loop
    Set rst = Nothing
    List1.Visible = True
End Sub
Private Sub Combo4_Click()
    Dim mrc As ADODB.Recordset
    txtsql = "select   DISTINCT 姓名 from xj where 学号 ='" & Trim(Combo4.Text) & "'"
    Set mrc = ExecuteSQL(txtsql)
    Text2.Text = mrc.Fields(0)
    Set mrc = Nothing
End Sub

Private Sub Combo4_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Dim mrc As ADODB.Recordset
        txtsql = "select   DISTINCT 姓名 from xj where 学号 ='" & _
            Trim(Combo4.Text) & "'"
        Set mrc = ExecuteSQL(txtsql)
        If mrc.EOF = True Then
            sss = MsgBox("没有此学号！", vbExclamation + vbOKOnly, "警告")
            Text2.Text = ""
            Exit Sub
        End If
        Text2.Text = mrc.Fields(0)
        Set mrc = Nothing
    Else
        aaa = False
    End If
End Sub
Private Sub Command1_Click()
    For i = 0 To 13
        If Trim(Text1(i).Text) = "" Then
            Text1(i).Text = "0"
        End If
    Next i
    If Combo4.Text = "" Then
        sss = MsgBox("学号不能为空！", vbExclamation + vbOKOnly, "警告")
        Combo4.SetFocus
        Exit Sub
    End If
    Dim mrc As ADODB.Recordset
    txtsql = "select 学号 from cj where 学号='" & Trim(Combo4.Text) & _
        "' and 学期='" & Trim(Combo1.Text) & "' and 类型='" & Trim(Combo3.Text) & "'"
    Set mrc = ExecuteSQL(txtsql)
    If mrc.EOF = False Then
        sss = MsgBox("已存在该学号本学期的成绩记录！", vbExclamation + vbOKOnly, "警告")
        Combo4.SetFocus
        Combo4.SelStart = 0
        Combo4.SelLength = Len(Combo4.Text)
        Exit Sub
    End If
    txtsql = "select  * from cj"
    Set mrc = ExecuteSQL(txtsql)
    For i = 0 To (kechengcount - 1)
        mrc.AddNew
        mrc.Fields(0) = Trim(Combo4.Text)
        mrc.Fields(1) = Trim(Combo1.Text)
        mrc.Fields(2) = Trim(Combo3.Text)
        mrc.Fields(3) = Trim(Label1(i).Caption)
        mrc.Fields(4) = Val(Trim(Text1(i).Text))
        mrc.Update
    Next i
    For i = 0 To 13
        Text1(i).Text = "0"
    Next i
    Combo4.Text = ""
    Text2.Text = ""
    Combo4.SetFocus
End Sub
Private Sub Command2_Click()
    Unload Me
End Sub
Private Sub Form_Activate()
    List1.Visible = False
    Dim mrc As ADODB.Recordset
    txtsql = "select  DISTINCT 班级  from class order by 班级"
    Set mrc = ExecuteSQL(txtsql)
    mrc.MoveFirst
    Combo2.Clear
    Do While Not mrc.EOF
        Combo2.AddItem mrc.Fields(0)
        mrc.MoveNext
    Loop
    Combo2.ListIndex = 0
    Combo1.AddItem Val(Format(Date, "yyyy")) - 1 & "---" & _
        Val(Format(Date, "yyyy")) & "年级第一学期"
    Combo1.AddItem Val(Format(Date, "yyyy")) - 1 & "---" & _
        Val(Format(Date, "yyyy")) & "年级第二学期"
    Combo1.AddItem Format(Date, "yyyy") & "---" & _
        Val(Format(Date, "yyyy")) + 1 & "年级第一学期"
    Combo1.AddItem Format(Date, "yyyy") & "---" & _
        Val(Format(Date, "yyyy")) + 1 & "年级第二学期"
    Combo1.AddItem Val(Format(Date, "yyyy")) + 1 & "---" & _
        Val(Format(Date, "yyyy")) + 2 & "年级第一学期"
    Combo1.AddItem Val(Format(Date, "yyyy")) + 1 & "---" & _
        Val(Format(Date, "yyyy")) + 2 & "年级第二学期"
    If Val(Format(Date, "mm")) > 8 Then
        Combo1.ListIndex = 2
    Else
        Combo1.ListIndex = 1
    End If
    txtsql = "select * from kaoshileixing"
    Set mrc = ExecuteSQL(txtsql)
    Combo3.Clear
    mrc.MoveFirst
    Do While Not mrc.EOF
        Combo3.AddItem mrc.Fields(0)
        mrc.MoveNext
    Loop
    Combo3.ListIndex = 0
    Set mrc = Nothing
    fillkencheng
End Sub
Private Sub fillkencheng()
    Dim mrc As ADODB.Recordset
    Dim mrc1 As ADODB.Recordset
    For i = 0 To 13
        Label1(i).Visible = False
        Text1(i).Visible = False
    Next i
    txtsql = "select 年级,专业,年制 from class where 班级='" & _
        Trim(Combo2.Text) & "'"
    Set mrc1 = ExecuteSQL(txtsql)
    txtsql = "select 课程名称 from classkecheng where 学期='" & _
        Trim(Combo1.Text) & "'and 年级='" & Trim(mrc1.Fields(0)) & _
            "' and 专业='" & Trim(mrc1.Fields(1)) & "' and 年制='" & _
            Trim(mrc1.Fields(2)) & "'"
    Set mrc1 = Nothing
    Set mrc = ExecuteSQL(txtsql)
    Dim ssss As String
    If mrc.EOF = True Then
        sss = MsgBox("请先设置班级课程！", vbExclamation + vbOKOnly, "警告")
        Command1.Enabled = False
        Command2.Enabled = False
        Label1(0).Visible = False
        Exit Sub
    End If
    Command1.Enabled = True
    Command2.Enabled = True
    mrc.MoveFirst
    kechengcount = mrc.RecordCount
    For i = 0 To (mrc.RecordCount - 1)
        Label1(i).Visible = True
        Text1(i).Visible = True
        Label1(i).Caption = mrc.Fields(0)
        Text1(i).Text = 0
        mrc.MoveNext
    Next i
    Text1(0).SetFocus
    Frame3.Height = 410 + Int(i / 2 + 0.5) * 360
    Frame1.Height = 2000 + Frame3.Height
    Me.Height = 1800 + Frame1.Height
    Set mrc = Nothing
End Sub
Private Sub Form_Resize()
    Command1.Top = Me.Height - 800
    Command2.Top = Me.Height - 800
End Sub
Private Sub List1_Click()
    aaa = True
    Combo4.Text = List1.List(List1.ListIndex)
End Sub
Private Sub Text1_GotFocus(Index As Integer)
    List1.Visible = False
    Text1(Index).SelStart = 0
    Text1(Index).SelLength = Len(Text1(6).Text)
End Sub
Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
    Dim shao As Integer
    Dim zs As String
    If KeyAscii <> 8 And KeyAscii <> 13 Then
        shao = InStr(Trim(Text1(Index).Text), ".")
        If shao <> 0 Then
            zs = Right(Trim(Text1(Index).Text), Len(Trim(Text1(Index).Text)) - shao)
            If Len(zs) > 1 Then KeyAscii = 0
        End If
    End If
    If Val(Text1(Index).Text & Chr(KeyAscii)) > 100 Then
        KeyAscii = 0
        Exit Sub
    End If
    If KeyAscii = 13 Or KeyAscii = 46 Or KeyAscii > 47 And KeyAscii < 58 _
        Or KeyAscii = 8 Then
    Else
        KeyAscii = 0
        Exit Sub
    End If
    If KeyAscii = 13 Then
    SendKeys "{TAB}"
    End If
End Sub