📄 import.frm
字号:
SourceDoc = "D:\Documents and Settings\Meteor\桌面\Meteor\new\help.chm"
TabIndex = 10
Top = 1680
Visible = 0 'False
Width = 135
End
Begin VB.Label biaoqian1
Alignment = 2 'Center
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Caption = "考号生成展示列表"
BeginProperty Font
Name = "隶书"
Size = 15.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF8080&
Height = 495
Index = 3
Left = 5280
TabIndex = 9
Top = 1200
Visible = 0 'False
Width = 4215
End
Begin VB.Label biaoqian1
Alignment = 2 'Center
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Caption = "考试成员列表"
BeginProperty Font
Name = "隶书"
Size = 15.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF8080&
Height = 495
Index = 2
Left = 10440
TabIndex = 6
Top = 1200
Width = 4455
End
Begin VB.Label biaoqian1
Alignment = 2 'Center
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Caption = "班级成员列表"
BeginProperty Font
Name = "隶书"
Size = 15.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF8080&
Height = 495
Index = 1
Left = 5280
TabIndex = 5
Top = 1200
Width = 4215
End
Begin VB.Label Label2
Alignment = 2 'Center
BorderStyle = 1 'Fixed Single
Caption = "原始数据导入列表"
BeginProperty Font
Name = "宋体"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 495
Left = 0
TabIndex = 4
Top = 0
Width = 3255
End
Begin VB.Label biaoqian1
Alignment = 2 'Center
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Caption = "原始数据导入列表"
BeginProperty Font
Name = "隶书"
Size = 15.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF8080&
Height = 495
Index = 0
Left = 360
TabIndex = 3
Top = 1200
Width = 3975
End
Begin VB.Menu menufile
Caption = "文件(&F)"
Begin VB.Menu menuimport
Caption = "数据导入(&I)"
Shortcut = ^I
End
Begin VB.Menu menudaochu
Caption = "导出到EXCEL"
Shortcut = ^O
End
Begin VB.Menu menuclear
Caption = "清空临时数据(&C)"
Shortcut = ^C
End
Begin VB.Menu menucreate
Caption = "生成考号(&M)"
Shortcut = ^M
End
Begin VB.Menu menunull
Caption = "-"
End
Begin VB.Menu menuexit
Caption = "退出"
Shortcut = ^X
End
End
Begin VB.Menu menuset
Caption = "设置(&L)"
Begin VB.Menu menusetting
Caption = "设置考场属性(&S)"
Shortcut = ^S
End
End
Begin VB.Menu menuhelp
Caption = "帮助(&H)"
Begin VB.Menu menubangzhu
Caption = "帮助文件(&F1)"
Shortcut = {F1}
End
End
Begin VB.Menu menuguanyu
Caption = "关于(&G)"
Begin VB.Menu menuabout
Caption = "关于本软件(&A)"
End
End
Begin VB.Menu menuhide
Caption = "隐藏菜单"
Visible = 0 'False
Begin VB.Menu delstu
Caption = "删除当前选中的学生"
End
Begin VB.Menu delclass
Caption = "删除当前选中的班级"
End
End
Begin VB.Menu menupaixu
Caption = "结果排序"
Visible = 0 'False
Begin VB.Menu menukaohao
Caption = "按考场排序"
End
Begin VB.Menu menubanji
Caption = "按班级排序"
End
Begin VB.Menu menushuxing
Caption = "树型列表展示"
End
Begin VB.Menu menubiaoge
Caption = "表格形式展示"
End
End
Begin VB.Menu menuall
Caption = "选中全部"
Visible = 0 'False
Begin VB.Menu menuaddall
Caption = "添加全部考生"
End
End
End
Attribute VB_Name = "import"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim listcount As Integer
Dim zrs As Integer '所选总人数
Dim paixufangshi As String
Dim zhankaifangshi As String '判断用户展开的方式
Dim statfp As Boolean '状态栏闪烁的字
Dim keshan As Boolean
Dim pubconn As ADODB.Connection '定义一个合局的数据连接
Dim DataPath As String '定义原始文件路径存储变量
Dim dyimport As Node '定义导入TREEVIEW控件对像
Dim dystu As Node '定义导入TREEVIEW控件对像
Dim dyfinish As Node '定义导入TREEVIEW控件对像
Dim zhankaiclass As String '当选择了成员后所要展开的树型列表
Public Sub viewfinish()
Dim finishrs As ADODB.Recordset
Dim finishrs1 As ADODB.Recordset '展开班级树型列表
Set finishrs = New ADODB.Recordset
finishtree.Nodes.Clear
'初始化入围队列
Set dyfinish = finishtree.Nodes.Add(, , "d", "考试入围队列", "yuanshi")
'分别展示出每个班级被选成员
Set finishrs1 = New ADODB.Recordset
sql = "select distinct [班级] from temp" '查询出参加考试班级
finishrs1.Open sql, pubconn, adOpenDynamic, adLockReadOnly
i = 0
While finishrs1.EOF = False
tempstr = finishrs1.Fields("班级")
i = ConClass(Mid(tempstr, 1, Len(tempstr) - 1))
'i = i + 1
Set dyfinish = finishtree.Nodes.Add("d", tvwChild, "class" & i, finishrs1.Fields("班级"), "banji")
sql = "select * from temp where [班级]='" & finishrs1.Fields("班级") & "'"
Set finishrs = New ADODB.Recordset
finishrs.Open sql, pubconn, adOpenDynamic, adLockReadOnly
temp1 = 0
finishrs.Requery
While finishrs.EOF = False
temp1 = temp1 + 1 '防止关键字冲突，用TEMP进行累加
Set dyfinish = finishtree.Nodes.Add("class" & i, tvwChild, "class" & i & temp1, finishrs.Fields("姓名"), "xingming")
finishrs.MoveNext
Wend
finishrs1.MoveNext '将班级移动到下一个记录
Wend
finishtree.Nodes("d").Expanded = True
' For t = 1 To finishtree.Nodes.Count - 1
' finishtree.Nodes(t).Expanded = True
' Next
End Sub
Public Sub import()
On Error GoTo chuli:
Dim temp As Integer
Dim sql As String '定义SQL语句存储变量
Dim sourcers As ADODB.Recordset '原始数据集合
Dim sourceconn As ADODB.Connection '原始数据连接
Dim importrs As ADODB.Recordset
Dim dytreers As ADODB.Recordset '添充TREEVIEW数据集
resulttree.Visible = False
resultgrid.Visible = False
listview1.Visible = True
showfile.DialogTitle = "导入EXCEL表格的原始数据"
showfile.Filter = "(*.xls)|*.XLS"
showfile.ShowOpen '查找原始数据文件
DataPath = showfile.FileName
If DataPath = "" Then
Exit Sub
End If
label1.Visible = True
label1.Caption = "正在清除"
Call setempty
label1.Visible = True
label1.Caption = "开始导入外部数据............"
Dim importNode As New nodetree
temp = importNode.importdata(DataPath)
label1.Visible = False
MsgBox "成功导入" & temp & "条数据!", vbOKOnly + 64, "提示"
showimporttree
Exit Sub
sql = "select distinct [班级] from import"
Set sourcers = New ADODB.Recordset
sourcers.Open sql, pubconn, adOpenDynamic, adLockPessimistic
'将原始数据表数据导入ACCESS表import 中
Set dytreers = New ADODB.Recordset '初始化原始数据的treeview
dytreers.Open "import", pubconn, adOpenDynamic, adLockReadOnly
Set dyimport = importtree.Nodes.Add(, , "d", "原始数据", "yuanshi")
t = 0
While sourcers.EOF = False
t = t + 1
Set dyimport = importtree.Nodes.Add("d", tvwChild, "class" & t, sourcers.Fields("班级"), "banji")
sourcers.MoveNext
Wend
Set dyfinish = finishtree.Nodes.Add(, , "d", "考试入围队列", "yuanshi") '初始化入围队列
sourcers.Requery
sourcers.MoveFirst
t = 0
While sourcers.EOF = False
t = t + 1
Set dyfinish = finishtree.Nodes.Add("d", tvwChild, "class" & t, sourcers.Fields("班级"), "banji")
sourcers.MoveNext
Wend
keshan = False '初始化BOOLEAN变量
fp = False
For i = 1 To importtree.Nodes.Count - 1 '展开列表
importtree.Nodes(i).Expanded = True
Next
Exit Sub
'错误处理程序
chuli:
jindu.Visible = False
jindu.Value = 0
If Err.Number = -2147467259 Or Err.Number = 3265 Then
MsgBox "非法的数据格式或是内部字段不符合要求，系统要求EXCEL表格数据 ，并且要求格式正确,请参看帮助,当前操作被取消！", vbOKOnly + 48, title
StatusBar1.Panels(2).Text = "当前用户操作：" & " 非法操作，" & Err.Description
ElseIf Err.Number = -1247217887 Or Err.Number = -2147217887 Or Err.Number = 35602 Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -