frmgridmodify.frm

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

      Begin VB.Menu MNUBJK 
         Caption         =   "生成班级成绩库[&B]"
      End
      Begin VB.Menu M41 
         Caption         =   "-"
      End
      Begin VB.Menu MNULOOK 
         Caption         =   "浏览已有成绩库[&L]"
      End
   End
   Begin VB.Menu MNUHELP 
      Caption         =   "【帮助&H】"
      Begin VB.Menu MNUHELP1 
         Caption         =   "使用说明[&N]"
      End
   End
End
Attribute VB_Name = "frmGrid"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public recForMain As Recordset
Dim ex As Excel.Application
Dim exwbook As Excel.WorkBook
Dim exsheet As Excel.WorkSheet
Dim exchart As Excel.Chart
Dim I, J As Integer
Private Sub cmdOld_Click()
'定义传输数据
On Error Resume Next
If MsgBox("确信要将这些选定数据移至旧库？", vbQuestion + vbYesNo, "信息提示") = vbNo Then
Exit Sub
Else
Dim XH As String
Dim XM As String
    '出生年月一定有,所以不显示
Dim XB As String
Dim MZ As String
Dim YX As String
Dim BJ As String
Dim HKSX As String
Dim NJ As String
Dim SY As String
Dim ZZMM As String
Dim TC As String
Dim SFZHM As String
Dim LTKHM As String
Dim SS As String
Dim DH As String
Dim XL As String
Dim ZY As String
Dim PYFS As String
Dim BYZX As String
'把当前数据送旧库,删数据
Dim I As Integer
Dim sqlZBQKB As String
Dim dbOldStudent As Database
Set dbOldStudent = OpenDatabase(App.Path + "\database\oldstudent.mdb", False, False)
If recForMain.BOF And recForMain.EOF Then
Exit Sub
End If

recForMain.MoveFirst
If Not IsNull(recForMain!XH) Then XH = recForMain!XH
If Not IsNull(recForMain!XM) Then XM = recForMain!XM
If Not IsNull(recForMain!XB) Then XB = recForMain!XB
If Not IsNull(recForMain!MZ) Then MZ = recForMain!MZ
If Not IsNull(recForMain!YX) Then YX = recForMain!YX
If Not IsNull(recForMain!BJ) Then BJ = recForMain!BJ
If Not IsNull(recForMain!HKSX) Then HKSX = recForMain!HKSX
If Not IsNull(recForMain!NJ) Then NJ = recForMain!NJ
If Not IsNull(recForMain!SY) Then SY = recForMain!SY
If Not IsNull(recForMain!ZZMM) Then ZZMM = recForMain!ZZMM
If Not IsNull(recForMain!TC) Then TC = recForMain!TC
If Not IsNull(recForMain!SFZHM) Then SFZHM = recForMain!SFZHM
If Not IsNull(recForMain!LTKHM) Then LTKHM = recForMain!LTKHM
If Not IsNull(recForMain!SS) Then SS = recForMain!SS
If Not IsNull(recForMain!DH) Then DH = recForMain!DH
If Not IsNull(recForMain!XL) Then XL = recForMain!XL
If Not IsNull(recForMain!ZY) Then ZY = recForMain!ZY
If Not IsNull(recForMain!PYFS) Then PYFS = recForMain!PYFS
If Not IsNull(recForMain!BYZX) Then BYZX = recForMain!BYZX
sqlZBQKB = "insert into zbqkb(xh,xm,csny,xb,mz,xl,yx,bj,hksx,nj,sy,zzmm,tc,sfzhm,ltkhm,ss,dh,zy,pyfs,byzx) "
sqlZBQKB = sqlZBQKB + "values('" + Trim(XH) + "','" + Trim(XM) + "',"
sqlZBQKB = sqlZBQKB + "'" + Trim(recForMain!CSNY) + "','" + Trim(XB) + "',"
sqlZBQKB = sqlZBQKB + "'" + Trim(MZ) + "','" + Trim(XL) + "'," + Trim(YX) + "',"
sqlZBQKB = sqlZBQKB + "'" + Trim(BJ) + "','" + Trim(HKSX) + "',"
sqlZBQKB = sqlZBQKB + "'" + Trim(NJ) + "','" + Trim(SY) + "',"
sqlZBQKB = sqlZBQKB + "'" + Trim(ZZMM) + "','" + Trim(TC) + "',"
sqlZBQKB = sqlZBQKB + "'" + Trim(SFZHM) + "','" + Trim(LTKHM) + "',"
sqlZBQKB = sqlZBQKB + "'" + Trim(SS) + "','" + Trim(DH) + "','"
sqlZBQKB = sqlZBQKB + "'" + Trim(ZY) + "','" + Trim(PYFS) + "','" + Trim(BYZX) + "')"
dbOldStudent.Execute sqlZBQKB
If MsgBox("数据移送完毕!是否要删除这些数据?", vbQuestion + vbYesNo, "警示信息") = vbNo Then
Exit Sub
End If
sqlZBQKB = "delete * from zbqkb where xh='" + Trim(XH) + "'"
Dbstudent.Execute sqlZBQKB
For I = 1 To recForMain.RecordCount - 1
XH = ""
XM = ""
XB = ""
MZ = ""
XL = ""
YX = ""
BJ = ""
HKSX = ""
NJ = ""
SY = ""
ZZMM = ""
TC = ""
SFZHM = ""
LTKHM = ""
SS = ""
DH = ""
ZY = ""
PYFS = ""
BYZX = ""
recForMain.MoveNext
If Not IsNull(recForMain!XH) Then XH = recForMain!XH
If Not IsNull(recForMain!XM) Then XM = recForMain!XM
If Not IsNull(recForMain!XB) Then XB = recForMain!XB
If Not IsNull(recForMain!MZ) Then MZ = recForMain!MZ
If Not IsNull(recForMain!YX) Then YX = recForMain!YX
If Not IsNull(recForMain!BJ) Then BJ = recForMain!BJ
If Not IsNull(recForMain!HKSX) Then HKSX = recForMain!HKSX
If Not IsNull(recForMain!NJ) Then NJ = recForMain!NJ
If Not IsNull(recForMain!SY) Then SY = recForMain!SY
If Not IsNull(recForMain!ZZMM) Then ZZMM = recForMain!ZZMM
If Not IsNull(recForMain!TC) Then TC = recForMain!TC
If Not IsNull(recForMain!SFZHM) Then SFZHM = recForMain!SFZHM
If Not IsNull(recForMain!LTKHM) Then LTKHM = recForMain!LTKHM
If Not IsNull(recForMain!SS) Then SS = recForMain!SS
If Not IsNull(recForMain!DH) Then DH = recForMain!DH
If Not IsNull(recForMain!XL) Then XL = recForMain!XL
If Not IsNull(recForMain!ZY) Then ZY = recForMain!ZY
If Not IsNull(recForMain!PYFS) Then PYFS = recForMain!PYFS
If Not IsNull(recForMain!BYZX) Then BYZX = recForMain!BYZX
sqlZBQKB = "insert into zbqkb(xh,xm,csny,xb,mz,yx,bj,hksx,nj,sy,zzmm,tc,sfzhm,ltkhm,ss,dh,xl,zy,pyfs,byzx) "
sqlZBQKB = sqlZBQKB + "values('" + Trim(XH) + "','" + Trim(XM) + "',"
sqlZBQKB = sqlZBQKB + "'" + Trim(recForMain!CSNY) + "','" + Trim(XB) + "',"
sqlZBQKB = sqlZBQKB + "'" + Trim(MZ) + "','" + Trim(YX) + "',"
sqlZBQKB = sqlZBQKB + "'" + Trim(BJ) + "','" + Trim(HKSX) + "',"
sqlZBQKB = sqlZBQKB + "'" + Trim(NJ) + "','" + Trim(SY) + "',"
sqlZBQKB = sqlZBQKB + "'" + Trim(ZZMM) + "','" + Trim(TC) + "',"
sqlZBQKB = sqlZBQKB + "'" + Trim(SFZHM) + "','" + Trim(LTKHM) + "',"
sqlZBQKB = sqlZBQKB + "'" + Trim(SS) + "','" + Trim(DH) + "','" + Trim(XL) + "',"
sqlZBQKB = sqlZBQKB + "'" + Trim(ZY) + "','" + Trim(PYFS) + "','" + Trim(BYZX) + "')"
dbOldStudent.Execute sqlZBQKB
sqlZBQKB = "delete * from zbqkb where xh='" + Trim(XH) + "'"
Dbstudent.Execute sqlZBQKB
Next I
MskGrdMain.Clear
End If

End Sub



Private Sub Form_Load()
'MSGRID控件的初始化
On Error Resume Next
Dim num As Integer
DataForMain.DatabaseName = App.Path + "\database\student.mdb"
Set recForMain = Dbstudent.OpenRecordset(sqlForMain, dbOpenSnapshot)
Set DataForMain.Recordset = recForMain
DataForMain.Recordset.MoveLast
DataForMain.Recordset.MoveFirst
num = DataForMain.Recordset.RecordCount
With MskGrdMain
  .Row = 0
  .col = 0
  .ColWidth(0) = 1600
  .Text = "学号"
  
  .col = 1
  .ColWidth(1) = 1000
  .Text = "姓名"
  
  .col = 2
  .ColWidth(2) = 1300
  .Text = "出生年月"
  
  .col = 3
  .ColWidth(3) = 500
  .Text = "性别"
  
  .col = 4
  .ColWidth(4) = 1000
  .Text = "民族"
  
  .col = 5
  .ColWidth(5) = 1000
  .Text = "学历"
  
  .col = 6
  .ColWidth(6) = 1900
  .Text = "院系"
  
  .col = 7
  .ColWidth(7) = 1200
  .Text = "班级"
  
  .col = 8
  .ColWidth(8) = 1000
  .Text = "户口属性"
  
  .col = 9
  .ColWidth(9) = 1000
  .Text = "年级"
  
  .col = 10
  .ColWidth(10) = 1000
  .Text = "生源"
  
  .col = 11
  .ColWidth(11) = 1000
  .Text = "政治面貌"
  
  .col = 12
  .ColWidth(12) = 2500
  .Text = "特长"
  
  .col = 13
  .ColWidth(13) = 2000
  .Text = "身份证号码"
  
  .col = 14
  .ColWidth(14) = 2000
  .Text = "灵通卡号码"
  
  .col = 15
  .ColWidth(15) = 1000
  .Text = "宿舍"
  
  .col = 16
  .ColWidth(16) = 1500
  .Text = "电话号码"
  
  .col = 17
  .ColWidth(17) = 2500
  .Text = "专业"
  
  .col = 18
  .ColWidth(18) = 1000
  .Text = "培养方式"
  
  .col = 19
  .ColWidth(19) = 3500
  .Text = "毕业中学"
End With

'Dim I As Integer
' For I = 2 To MskGrdMain.Rows
'        MskGrdMain.Row = I - 1
'        MskGrdMain.col = 0
'        MskGrdMain.CellBackColor = &HFFFF00
'        'MskGrdMain.Col = 1
'        'MskGrdMain.CellBackColor = &HFFFF00
'Next I
SBar1.Panels(1).Text = "共检索到" & num & "条记录!"
On Error Resume Next
Line1.X1 = 0
Line1.X2 = frmGrid.Width
MskGrdMain.Left = (frmGrid.Width - MskGrdMain.Width) / 2 - 50
MskGrdMain.ForeColor = &H800000   'vbBlue
'MskGrdMain.BackColor = &HFFFF00
If banj = "" Then
MNUBJK.Enabled = False
MNUPRNNAME.Enabled = False
End If

FlatBar1.SetToolBAar Toolbar1, 2
End Sub

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

Private Sub MNUBF_Click()
If MsgBox("将要处理数据,可能花费较长时间,请耐心等待。当数据传至EXCEL后，选择‘另存为’将文件存成.DBF的格式，即是毕业分配办所需的文件！", 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 = DataForMain.Recordset
'rec.MoveFirst
If REC.AbsolutePosition = -1 Then
MsgBox "无信息转化，退出！", vbExclamation, "错误信息"
GoTo 10
End If

REC.MoveLast
REC.MoveFirst
q = REC.RecordCount

ex.Cells(1, 1).Value = "BJ"
ex.Cells(1, 2).Value = "XH"
ex.Cells(1, 3).Value = "ZYMC"
ex.Cells(1, 4).Value = "XL"
ex.Cells(1, 5).Value = "XZ"
ex.Cells(1, 6).Value = "XM"
ex.Cells(1, 7).Value = "XB"
ex.Cells(1, 8).Value = "MZ"
ex.Cells(1, 9).Value = "ZZMM"
ex.Cells(1, 10).Value = "CSRQ"
ex.Cells(1, 11).Value = "PYFS"
ex.Cells(1, 12).Value = "LYSS"
ex.Cells(1, 13).Value = "JTDZ"
ex.Cells(1, 14).Value = "YZBM"
ex.Cells(1, 15).Value = "QSH"
ex.Cells(1, 16).Value = "DHHM"

'处理学号数据
'rec.MoveFirst
For I = 2 To q + 1
With ex

 .Cells(I, 1).Value = REC(7).Value
 .Cells(I, 2).Value = REC(0).Value
 .Cells(I, 3).Value = REC(17).Value
 .Cells(I, 4).Value = REC(5).Value
 If REC(5).Value = "本科" Then
 .Cells(I, 5).Value = "4年"
 Else
 .Cells(I, 5).Value = "3年"
 End If
 .Cells(I, 6).Value = REC(1).Value