kcszform.frm

哈哈

    Set pubconn = New ADODB.Connection
    pubconn.ConnectionString = pubconnstr
    pubconn.Open
    showjilu
    paixu.AddItem "随机排号"
    paixu.AddItem "按成绩排号"
    paixu.Text = pxfs
    biaoshi.Text = exambiaoshi
    Me.BorderStyle = 0
   
    
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 1 Then    '调用API函数，让窗体可以移动
       ReleaseCapture
       SendMessage Me.hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&
    End If
End Sub

Private Sub kaochangtree_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then
       PopupMenu menuadd
    End If
End Sub

Private Sub kaochangtree_NodeClick(ByVal Node As MSComctlLib.Node)
    If Right(Node, 2) <> "考场" Then
       menudelete.Enabled = False
       menuxiugai.Enabled = False
     Else
       menudelete.Enabled = True
       menuxiugai.Enabled = True
       tempchoose = Node
     End If
End Sub

Private Sub menuaddnew_Click()
    On Error GoTo chuli:
    Dim kr As Integer
    Dim kd As String
    Dim jilushu As Integer
    Dim kaochangmc As String
    Set pubconn = New ADODB.Connection
    pubconn.ConnectionString = pubconnstr
    pubconn.Open
    Set pubrs = New ADODB.Recordset
    pubrs.Open "select count(*) as zongshu from exam", pubconn, adOpenDynamic, adLockPessimistic
        jilushu = pubrs.Fields("zongshu")
             
    If jilushu < 1 Then
       jilushu = 1
    Else
       jilushu = jilushu + 1
       pubrs.close
       pubrs.Open "select * from exam", pubconn, adOpenDynamic, adLockPessimistic
       pubrs.MoveFirst
      While pubrs.EOF = False
            If pubrs.Fields("考场名称") = jilushu & "考场" Then
               jilushu = jilushu - 1
               pubrs.MoveFirst
            Else
               pubrs.MoveNext
            End If
      Wend
    End If
    kd = InputBox("请输入考场地点:", "添加新考场", "")
    kr = InputBox("请输入考场人数:", "添加新考场", "10")
    If kd = "" Or kr < 1 Then
       MsgBox "请输入正确的考场信息", vbOKOnly + 48, title
       Exit Sub
    Else
       pubrs.close
       Set pubrs = New ADODB.Recordset
       pubrs.Open "select * from exam", pubconn, adOpenDynamic, adLockPessimistic
       pubrs.AddNew
       pubrs.Fields("考场名称") = (jilushu) & "考场"
       pubrs.Fields("考场地点") = kd
       pubrs.Fields("考场人数") = kr
       pubrs.Update
    End If
    Call showjilu
    Exit Sub
chuli:
    If Err.Number = 13 Then
       MsgBox "考场人数只能为大于1的数字！", vbOKOnly + 48, title
    Else
     MsgBox Err.Number & "   " & Err.Description
    End If
End Sub

Private Sub menudelete_Click()
  sql = "delete * from exam where [考场名称]='" & tempchoose & "'"
  Dim temprs As ADODB.Recordset
  Set temprs = New ADODB.Recordset
  temprs.Open sql, pubconn, adOpenDynamic, adLockPessimistic
  Call showjilu   '刷新列表
End Sub





Private Sub menuxiugai_Click()
On Error GoTo chuli:
  sql = "select * from exam where [考场名称]='" & tempchoose & "'"
  Dim temprs As ADODB.Recordset
  Set temprs = New ADODB.Recordset
  temprs.Open sql, pubconn, adOpenDynamic, adLockPessimistic
  kd = InputBox("请输入考场地点:", "添加新考场", temprs.Fields("考场地点"))
  kr = InputBox("请输入考场人数:", "添加新考场", temprs.Fields("考场人数"))
    If kd = "" Or kr < 1 Then
       MsgBox "请输入正确的考场信息", vbOKOnly + 48, title
       Exit Sub
    Else                                  '修改所选记录
       temprs.Fields("考场地点") = kd
       temprs.Fields("考场人数") = kr
       temprs.Update
    End If
    tempchoose = ""
    Call showjilu   '刷新列表
    Exit Sub
chuli:
    If Err.Number = 13 Or Err.Number = -2147352571 Then
       MsgBox "考场人数只能为大于1的数字！", vbOKOnly + 48, title
    Else
       MsgBox Err.Number & "   " & Err.Description
    End If
End Sub

Private Sub paixu_LostFocus()
    pxfs = paixu.Text
End Sub

Private Sub shanchu_Click()
      If Right(tempchoose, 2) <> "考场" Then
         MsgBox "请选中班级后再进行删除!", vbOKOnly + 48, title
      Else
         Call menudelete_Click
      End If
End Sub

Private Sub tianjia_Click()
  Call menuaddnew_Click
End Sub




Public Sub import()
On Error GoTo chuli:
'   Dim sql As String                   '定义SQL语句存储变量
'   Dim sourcers As ADODB.Recordset     '原始数据集合
'   Dim sourceconn As ADODB.Connection  '原始数据连接
'   Dim importrs As ADODB.Recordset
    Dim ExamNode As New nodetree
    Dim TmpNum As Integer
    showfile.Filter = "(考场文件)|*.xls"
    showfile.ShowOpen                 '查找原始数据文件
    DataPath = showfile.FileName
    If DataPath = "" Then
        Exit Sub
    End If
    cmdPro.Visible = True
    TmpNum = ExamNode.importexam(DataPath)
    MsgBox "共导入" & TmpNum & "个合法考场!", vbOKOnly + 64, "提示"
    cmdPro.Visible = False
    Call showjilu
'    Dim temprs As ADODB.Recordset
'    Set temprs = New ADODB.Recordset
'    sql = "delete * from exam"
'    temprs.Open sql, pubconn, adOpenDynamic, adLockPessimistic
''初始化数据连接
'Set sourceconn = New ADODB.Connection
'    sourceconn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & DataPath & ";Extended Properties=""Excel 8.0;"""
'    sourceconn.Open
'      '将原始数据表数据导入ACCESS表import 中
'
'    Set importrs = New ADODB.Recordset
'    Set sourcers = New ADODB.Recordset
'
'    sourcers.Open "select * from [sheet1$]", sourceconn, adLockOptimistic, adLockOptimistic
'    importrs.Open "exam", pubconn, adOpenDynamic, adLockPessimistic
'    While sourcers.EOF = False
'        If CStr(sourcers.Fields("考场名称")) = "" Or CStr(sourcers.Fields("考场地点")) = "" Or sourcers.Fields("考场人数") = "" Or Val(sourcers.Fields("考场人数")) < 1 Then
'           If MsgBox("导入的考场中，此条考场内容不合法，或是没有添写完全，是否继续导入其它的数据？", vbYesNo, title) = vbNo Then
'              sourcers.MoveLast
'              sourcers.MoveNext
'           Else
'                sourcers.MoveNext
'           End If
'        Else
'                importrs.AddNew
'                importrs.Fields("考场名称") = CStr(sourcers.Fields("考场名称"))
'                importrs.Fields("考场地点") = CStr(sourcers.Fields("考场地点"))
'                importrs.Fields("考场人数") = sourcers.Fields("考场人数")
'                importrs.Update
'                sourcers.MoveNext
'        End If
'     Wend
'    importrs.close            '关闭数据库接,释放系统资源
'    Call showjilu
'    kaoshibiao.Refresh
'    Set importrs = Nothing
'    sourcers.close
'    Set sourcers = Nothing
'
    Exit Sub
                             
'错误处理程序
chuli:
If Err.Number = -2147467259 Or Err.Number = 3265 Then
   MsgBox "非法的数据格式或是内部字段不符合要求，系统要求EXCEL表格数据 ，并且要求格式正确,请参看帮助,当前操作被取消！", vbOKOnly + 48, title
    
Else
   MsgBox Err.Number & " " & Err.Description, vbOKOnly + 48, title
     
End If
End Sub



Public Sub showjilu()
   kaochangtree.Nodes.Clear
   Set pubrs = New ADODB.Recordset
   'pubrs.CursorLocation = adUseClient
   pubrs.Open "select * from exam order by [考场名称] asc", pubconn, adOpenDynamic, adLockPessimistic
   Set kctree = kaochangtree.Nodes.Add(, , "d", "考场列表", "yuanshi")
   tempkc = 0
   While pubrs.EOF = False
         Set kctree = kaochangtree.Nodes.Add("d", tvwChild, "class" & temp, pubrs.Fields("考场名称"), "kaochang")
         Set kctree = kaochangtree.Nodes.Add("class" & temp, tvwChild, "renshu" & temp, "允许考生人员：" & pubrs.Fields("考场人数") & "名", "xingming")
         Set kctree = kaochangtree.Nodes.Add("class" & temp, tvwChild, "didian" & temp, "考场地点位于：" & pubrs.Fields("考场地点"), "xuehao")
         temp = temp + 1
         pubrs.MoveNext
   Wend
   kaochangtree.Nodes(1).Expanded = True
End Sub