frmfordjtzb.frm

教务管理系统,用VB 完成,以SQL SERVER 2000作为后台数据库

If Not IsNull(recForDJTZ!BJ) Then txtBJ = recForDJTZ!BJ
If Not IsNull(recForDJTZ!YX) Then txtYX = recForDJTZ!YX
If Not IsNull(recForDJTZ!NJ) Then txtNJ = recForDJTZ!NJ
If Not IsNull(recForDJTZ!SB) Then cboSB = recForDJTZ!SB
If Not IsNull(recForDJTZ!SXSJ) Then
    If Len(Year(recForDJTZ!SXSJ)) = 2 Then
        Year0 = "19" & CStr(Year(recForDJTZ!SXSJ))
    Else
        Year0 = CStr(Year(recForDJTZ!SXSJ))
    End If
    If Len(Month(recForDJTZ!SXSJ)) = 1 Then
        Month0 = "0" & CStr(Month(recForDJTZ!SXSJ))
    Else
        Month0 = CStr(Month(recForDJTZ!SXSJ))
    End If
    If Len(Day(recForDJTZ!SXSJ)) = 1 Then
        Day0 = "0" & CStr(Day(recForDJTZ!SXSJ))
    Else
        Day0 = CStr(Day(recForDJTZ!SXSJ))
    End If
    mskSXSJ = Month0 + "/" + Day0 + "/" + Year0
End If
If Not IsNull(recForDJTZ!CL) Then txtCL = recForDJTZ!CL
End Sub
'数据测试
Function CheckItem() As Boolean
On Error Resume Next
CheckItem = True
If Not IsNull(mskSXSJ) Then
    If Not IsDate(mskSXSJ) Then
        CheckItem = False
    End If
Else
    mskSXSJ = "1900-1-1"
End If
End Function
'数据集中有否此记录
Function XHInDJTZB(ByVal XHForDetect As String) As Boolean
On Error Resume Next
Dim sqlForXH As String
Dim recForXH As Recordset
XHInDJTZB = True
sqlForXH = "select top 1 * from djtzb where xh='" + XHForDetect + "'"
Set recForXH = Dbstudent.OpenRecordset(sqlForXH, dbOpenSnapshot)
If recForXH.RecordCount = 0 Then
    XHInDJTZB = False
End If
End Function
'更新记录集,记录号,记录数
Private Sub UpdateRecord()
On Error Resume Next
Dim sqlForDJTZB As String
sqlForDJTZB = "select * from djtzb"
Set recForDJTZ = Dbstudent.OpenRecordset(sqlForDJTZB, dbOpenSnapshot)
BookMark = 1
If recForDJTZ.RecordCount <> 0 Then
    recForDJTZ.MoveLast
    recForDJTZ.MoveFirst
    RecordCount = recForDJTZ.RecordCount
Else
    RecordCount = 0
    BookMark = 0
End If
End Sub

Public Sub InitItem()
On Error Resume Next
txtXH = ""
txtXM = ""
txtBJ = ""
txtYX = ""
txtNJ = ""
cboSB = ""
mskSXSJ = "__/__/____"
txtCL = ""
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Unload Me
End Sub

Private Sub MNUEXIT_Click()
On Error Resume Next
Call cmdExit_Click
End Sub

Private Sub MNUNOTE_Click()
Dim TTT As String
Dim x
TTT = App.Path + "\HELP\djcl.TXT"
x = Shell("Notepad " + TTT, 1)
End Sub

Private Sub MNUVIEW_Click()
If MsgBox("将要处理数据,可能花费较长时间,请稍候……", vbInformation + vbOKCancel, "提示框") = vbCancel Then
Exit Sub
Screen.MousePointer = 0
Else
Set ex = CreateObject("excel.application")
Set exwbook = ex.Workbooks().Add
Set exsheet = exwbook.Worksheets("sheet1")
Dim rec As Recordset
Dim q As Integer
Screen.MousePointer = 11
Set rec = recForDJTZ
'rec.MoveFirst
If rec.AbsolutePosition = -1 Then
MsgBox "无信息可供打印,退出!", vbExclamation, "错误信息"
GoTo 10
End If
rec.MoveLast
rec.MoveFirst
q = rec.RecordCount

ex.Caption = "学生党建材料一览"
ex.Cells(1, 5).Value = "学生党建材料报表"

ex.Cells(3, 1).Value = "学号"
ex.Cells(3, 2).Value = "姓名"
ex.Cells(3, 3).Value = "班级"
ex.Cells(3, 4).Value = "院系"
ex.Cells(3, 5).Value = "年级"
ex.Cells(3, 6).Value = "材料属性"
ex.Cells(3, 7).Value = "申请时间"
ex.Cells(3, 8).Value = "材料内容"

For I = 4 To q + 3
For J = 1 To 8
  ex.Cells(I, J).Value = rec(J).Value
 Next J
 rec.MoveNext
  Next I
ex.Visible = True
exwbook.Saved = True
rec.MoveFirst

10:
Screen.MousePointer = vbArrow
Set exsheet = Nothing
Set exwbook = Nothing
Set ex = Nothing
End If
End Sub

Private Sub MNUXH_Click()
On Error Resume Next
XH = ""
frmDinW.Show vbModal
If Len(XH) <> 0 Then
      recForDJTZ.FindFirst "xh='" + Trim(XH) + "' "
      If recForDJTZ.NoMatch Then
          MsgBox "学号不存在", vbExclamation + vbOKOnly, "提示"
      Else
          FillIn
      End If
  End If
BookMark = recForDJTZ.AbsolutePosition + 1

End Sub

Private Sub mskSXSJ_KeyPress(KeyAscii As Integer)
On Error Resume Next
Dim sqlModify As String
Dim BookMarkSave As Integer
Dim I As Integer
If KeyAscii = 13 Then
    If Modify Then
        If CheckItem Then
            sqlModify = "update djtzb set sxsj='" + Trim(CDate(mskSXSJ)) + "' where id=" + Trim(recForDJTZ!ID) + ""
            Dbstudent.Execute sqlModify
            If MsgBox("保存对当条记录的修改?", vbInformation + vbYesNo) = vbNo Then
                Exit Sub
            End If
            cmdSave.Caption = "保存"
            cmdSave.Enabled = False
            BookMarkSave = BookMark
            UpdateRecord
            For I = 1 To BookMarkSave - 1
              recForDJTZ.MoveNext
              FillIn
            Next I
            cmdSave.Caption = "保存"
            BookMark = BookMarkSave
            Modify = False
            cmdModify.Enabled = True
            cmdNext.Enabled = True
            cmdPrevious.Enabled = True
        Else
            MsgBox "数据输入有误!", vbInformation, "错误提示"
            mskSXSJ = "__/__/____"
            mskSXSJ.SetFocus
        End If
    End If
End If
End Sub

Private Sub txtBJ_KeyPress(KeyAscii As Integer)
On Error Resume Next
Dim sqlModify As String
Dim BookMarkSave As Integer
Dim I As Integer
If KeyAscii = 13 Then
    If Modify Then
        sqlModify = "update djtzb set bj='" + Trim(txtBJ) + "' where id=" + Trim(recForDJTZ!ID) + ""
        Dbstudent.Execute sqlModify
        If MsgBox("保存对当条记录的修改?", vbInformation + vbYesNo) = vbNo Then
            Exit Sub
        End If
        cmdSave.Enabled = False
        cmdSave.Caption = "保存"
        BookMarkSave = BookMark
        UpdateRecord
        For I = 1 To BookMarkSave - 1
          recForDJTZ.MoveNext
          FillIn
        Next I
        BookMark = BookMarkSave
        Modify = False
        cmdModify.Enabled = True
        cmdNext.Enabled = True
        cmdPrevious.Enabled = True
    End If
End If
End Sub

Private Sub txtCL_KeyPress(KeyAscii As Integer)
On Error Resume Next
Dim sqlModify As String
Dim BookMarkSave As Integer
Dim I As Integer
If KeyAscii = 13 Then
    If Modify Then
        sqlModify = "update djtzb set cl='" + Trim(txtCL) + "' where id=" + Trim(recForDJTZ!ID) + ""
        Dbstudent.Execute sqlModify
        If MsgBox("保存对当条记录的修改?", vbInformation + vbYesNo) = vbNo Then
            Exit Sub
        End If
        cmdSave.Enabled = False
        cmdSave.Caption = "保存"
        BookMarkSave = BookMark
        UpdateRecord
        For I = 1 To BookMarkSave - 1
          recForDJTZ.MoveNext
          FillIn
        Next I
        BookMark = BookMarkSave
        Modify = False
        cmdModify.Enabled = True
        cmdNext.Enabled = True
        cmdPrevious.Enabled = True
    End If
End If
End Sub

Private Sub txtNJ_KeyPress(KeyAscii As Integer)
On Error Resume Next
Dim sqlModify As String
Dim BookMarkSave As Integer
Dim I As Integer
If KeyAscii = 13 Then
    If Modify Then
        sqlModify = "update djtzb set nj='" + Trim(txtNJ) + "' where id=" + Trim(recForDJTZ!ID) + ""
        Dbstudent.Execute sqlModify
        If MsgBox("保存对当条记录的修改?", vbInformation + vbYesNo) = vbNo Then
            Exit Sub
        End If
        cmdSave.Enabled = False
        cmdSave.Caption = "保存"
        BookMarkSave = BookMark
        UpdateRecord
        For I = 1 To BookMarkSave - 1
          recForDJTZ.MoveNext
          FillIn
        Next I
        BookMark = BookMarkSave
        Modify = False
        cmdModify.Enabled = True
        cmdNext.Enabled = True
        cmdPrevious.Enabled = True
    End If
End If
End Sub

Private Sub txtXH_LostFocus()
On Error Resume Next
Dim sqlForNew, sqlForNew1 As String
Dim recForNew, recForNew1 As Recordset
If AddNew Then
    If XHInZBQKB(txtXH) Then
        sqlForNew1 = "select * from djtzb where xh='" + Trim(txtXH) + "'"
        Set recForNew1 = Dbstudent.OpenRecordset(sqlForNew1, dbOpenSnapshot)
        If recForNew1.BOF And recForNew1.EOF Then
           sqlForNew = "select top 1 xm,bj,yx,nj from zbqkb where xh='" + Trim(txtXH) + "'"
           Set recForNew = Dbstudent.OpenRecordset(sqlForNew, dbOpenSnapshot)
           If Not IsNull(recForNew!XM) Then txtXM = recForNew!XM
           If Not IsNull(recForNew!BJ) Then txtBJ = recForNew!BJ
           If Not IsNull(recForNew!YX) Then txtYX = recForNew!YX
           If Not IsNull(recForNew!NJ) Then txtNJ = recForNew!NJ
           cmdSave.Enabled = True
        Else
           MsgBox "库中已有该同学记录！", vbExclamation, "提示框"
             Dim s As String
             s = Trim(txtXH)
             recForDJTZ.MoveFirst
             recForDJTZ.FindFirst "xh='" + Trim(s) + "'"
             FillIn
             txtXH.SetFocus
             AddNew = False
        End If
     Else
        MsgBox "基本表中无此学号", vbInformation, "错误提示"
        txtXH = ""
        txtXH.SetFocus
    End If
End If
End Sub
'基本表中是否有此学号
Function XHInZBQKB(ByVal XHForDetect As String) As Boolean
On Error Resume Next
Dim sqlForXH As String
Dim recForXH As Recordset
XHInZBQKB = True
sqlForXH = "select top 1 * from zbqkb where xh='" + XHForDetect + "'"
Set recForXH = Dbstudent.OpenRecordset(sqlForXH, dbOpenSnapshot)
If recForXH.RecordCount = 0 Then
    XHInZBQKB = False
End If
End Function

Private Sub txtXM_KeyPress(KeyAscii As Integer)
On Error Resume Next
Dim sqlModify As String
Dim BookMarkSave As Integer
Dim I As Integer
If KeyAscii = 13 Then
    If Modify Then
        sqlModify = "update djtzb set xm='" + Trim(txtXM) + "' where id=" + Trim(recForDJTZ!ID) + ""
        Dbstudent.Execute sqlModify
        If MsgBox("保存对当条记录的修改?", vbInformation + vbYesNo) = vbNo Then
            Exit Sub
        End If
        cmdSave.Enabled = False
        cmdSave.Caption = "保存"
        BookMarkSave = BookMark
        UpdateRecord
        For I = 1 To BookMarkSave - 1
          recForDJTZ.MoveNext
          FillIn
        Next I
        BookMark = BookMarkSave
        Modify = False
        cmdModify.Enabled = True
        cmdNext.Enabled = True
        cmdPrevious.Enabled = True
    End If
End If
End Sub

Private Sub txtYX_KeyPress(KeyAscii As Integer)
On Error Resume Next
Dim sqlModify As String
Dim BookMarkSave As Integer
Dim I As Integer
If KeyAscii = 13 Then
    If Modify Then
        sqlModify = "update djtzb set yx='" + Trim(txtYX) + "' where id=" + Trim(recForDJTZ!ID) + ""
        Dbstudent.Execute sqlModify
        If MsgBox("保存对当条记录的修改?", vbInformation + vbYesNo) = vbNo Then
            Exit Sub
        End If
        cmdSave.Enabled = False
        cmdSave.Caption = "保存"
        BookMarkSave = BookMark
        UpdateRecord
        For I = 1 To BookMarkSave - 1
          recForDJTZ.MoveNext
          FillIn
        Next I
        BookMark = BookMarkSave
        Modify = False
        cmdModify.Enabled = True
        cmdNext.Enabled = True
        cmdPrevious.Enabled = True
    End If
End If
End Sub