📄 frmexcelzh.frm
字号:
VERSION 5.00
Object = "{90F3D7B3-92E7-44BA-B444-6A8E2A3BC375}#1.0#0"; "ACTSKIN4.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form FRMEXCELZH
Caption = "EXCEL格式转换为NHB数据格式"
ClientHeight = 4020
ClientLeft = 60
ClientTop = 450
ClientWidth = 5145
Icon = "FRMEXCELZH.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 4020
ScaleWidth = 5145
StartUpPosition = 2 '屏幕中心
Begin VB.Frame Frame1
Caption = "基本数据建立"
Height = 3675
Left = 120
TabIndex = 0
Top = 180
Width = 4845
Begin VB.Frame Frame2
Caption = "考试参数"
Height = 2295
Left = 180
TabIndex = 5
Top = 750
Width = 4485
Begin VB.TextBox Text1
Alignment = 2 'Center
ForeColor = &H00FF0000&
Height = 285
Left = 1440
TabIndex = 11
Text = "2002"
Top = 360
Width = 870
End
Begin VB.TextBox Text2
Alignment = 2 'Center
ForeColor = &H00FF0000&
Height = 285
Left = 3210
TabIndex = 9
Text = "2003"
Top = 360
Width = 990
End
Begin VB.ComboBox Combo3
ForeColor = &H00FF0000&
Height = 300
ItemData = "FRMEXCELZH.frx":030A
Left = 1440
List = "FRMEXCELZH.frx":0314
Style = 2 'Dropdown List
TabIndex = 8
Top = 810
Width = 1665
End
Begin VB.ComboBox Combo4
ForeColor = &H00FF0000&
Height = 300
ItemData = "FRMEXCELZH.frx":0328
Left = 1440
List = "FRMEXCELZH.frx":032A
Style = 2 'Dropdown List
TabIndex = 6
Top = 1770
Width = 1695
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 315
Left = 1440
TabIndex = 7
Top = 1290
Width = 1665
_ExtentX = 2937
_ExtentY = 556
_Version = 393216
CalendarTitleBackColor= 16638646
Format = 24641536
CurrentDate = 37788
End
Begin MSComCtl2.UpDown UpDown1
Height = 285
Left = 2310
TabIndex = 10
Top = 360
Width = 255
_ExtentX = 450
_ExtentY = 503
_Version = 393216
Value = 1900
AutoBuddy = -1 'True
BuddyControl = "DTPicker1"
BuddyDispid = 196619
OrigLeft = 2190
OrigTop = 360
OrigRight = 2445
OrigBottom = 675
Max = 9999
Min = 1000
SyncBuddy = -1 'True
BuddyProperty = 65547
Enabled = -1 'True
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel3
Height = 255
Index = 0
Left = 210
OleObjectBlob = "FRMEXCELZH.frx":032C
TabIndex = 12
Top = 390
Width = 1065
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel3
Height = 255
Index = 1
Left = 2760
OleObjectBlob = "FRMEXCELZH.frx":038B
TabIndex = 13
Top = 390
Width = 255
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel3
Height = 255
Index = 2
Left = 210
OleObjectBlob = "FRMEXCELZH.frx":03E2
TabIndex = 14
Top = 870
Width = 1065
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel3
Height = 255
Index = 3
Left = 210
OleObjectBlob = "FRMEXCELZH.frx":0441
TabIndex = 15
Top = 1350
Width = 1065
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel3
Height = 255
Index = 4
Left = 210
OleObjectBlob = "FRMEXCELZH.frx":04A0
TabIndex = 16
Top = 1800
Width = 1065
End
End
Begin VB.ComboBox Combo1
ForeColor = &H000000FF&
Height = 300
Left = 945
Style = 2 'Dropdown List
TabIndex = 3
Top = 300
Width = 1125
End
Begin VB.ComboBox Combo2
ForeColor = &H000000FF&
Height = 300
ItemData = "FRMEXCELZH.frx":04FF
Left = 3945
List = "FRMEXCELZH.frx":055D
Style = 2 'Dropdown List
TabIndex = 2
Top = 300
Width = 675
End
Begin VB.Timer Timer1
Interval = 1
Left = 4185
Top = 6450
End
Begin VB.CommandButton CMNEXT
Caption = "下一步"
Height = 435
Left = 3645
TabIndex = 1
Top = 3120
Width = 1035
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel1
Height = 255
Left = 225
OleObjectBlob = "FRMEXCELZH.frx":05D0
TabIndex = 4
Top = 300
Width = 735
End
Begin ACTIVESKINLibCtl.Skin Skin1
Left = -30
OleObjectBlob = "FRMEXCELZH.frx":062B
Top = -60
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel2
Height = 255
Left = 3165
OleObjectBlob = "FRMEXCELZH.frx":4AB1A
TabIndex = 17
Top = 330
Width = 735
End
End
End
Attribute VB_Name = "FRMEXCELZH"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim db As Database
Dim rs As Recordset
Dim STR As String
Dim NUM As Long
Dim SHFileOp As SHFILEOPSTRUCT
Dim HHVI As String '名称保存
Dim HHVIHA As String '共打印的标题
Dim gyxes As Integer '共班级数目变量
Private Sub CMNEXT_Click()
On Error Resume Next
MousePointer = vbHourglass
HHVI = Text1.Text & "至" & Text2.Text & Combo3.Text & Combo1.Text & Combo4.Text & DTPicker1.Value
HHVIHA = Text1.Text & "至" & Text2.Text & Combo3.Text & Combo1.Text & Combo4.Text
SHFileOp.wFunc = FO_COPY
SHFileOp.pFrom = App.Path & "\DATA.PAS"
SHFileOp.pTo = App.Path & "\TEMP\" & HHVI & ".NHB"
SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMMKDIR + FOF_NOCONFIRMATION
Call SHFileOperation(SHFileOp)
'以下代码将选择的设置进行名称保存,并且COPY于APP.PATH\TEMP下,暂存
Set db = OpenDatabase(App.Path & "\TEMP\" & HHVI & ".NHB")
STR = "INSERT INTO COM (标记,代码) VALUES ('完整名称','" & HHVI & "')"
db.Execute STR
db.Close
Set db = OpenDatabase(App.Path & "\TEMP\" & HHVI & ".NHB")
STR = "INSERT INTO COM (标记,代码) VALUES ('名称','" & HHVIHA & "')"
db.Execute STR
db.Close
Set db = OpenDatabase(App.Path & "\TEMP\" & HHVI & ".NHB")
STR = "INSERT INTO 年级 (年级,学年1,学年2,学期,考试日期,考试名称,班级数) VALUES ('" & Combo1 & "','" & Text1 & "','" & Text2 & "','" & Combo3 & "','" & DTPicker1 & "','" & Combo4 & "','" & Combo2 & "')"
db.Execute STR
db.Close
For gyxes = 1 To Combo2
Set db = OpenDatabase(App.Path & "\TEMP\" & HHVI & ".NHB")
STR = "INSERT INTO 班级 (班级) VALUES ('" & gyxes & "')"
db.Execute STR
db.Close
Next
DD = HHVI
FRMEXCELZH1.Show
MousePointer = vbDefault
Unload Me
End Sub
Private Sub Form_Activate()
On Error Resume Next
Combo1.Clear
Combo4.Clear
Set db = OpenDatabase(App.Path & "\SET.PAS")
Set rs = db.OpenRecordset("年级")
rs.MoveLast
intRecCount = rs.RecordCount
rs.MoveFirst
For intCounter = 1 To intRecCount
Combo1.AddItem rs![年级]
rs.MoveNext
Next intCounter
Combo1.ListIndex = 0
Set db = OpenDatabase(App.Path & "\SET.PAS")
Set rs = db.OpenRecordset("考试名称")
rs.MoveLast
intRecCount = rs.RecordCount
rs.MoveFirst
For intCounter = 1 To intRecCount
Combo4.AddItem rs![考试名称]
rs.MoveNext
Next intCounter
Combo4.ListIndex = 0
End Sub
Private Sub Form_Load()
On Error Resume Next
MAIN.Enabled = False
' Skin1.LoadSkin App.Path & "\SKIN\8.sk"
Skin1.ApplySkin Me.hwnd
Combo2.ListIndex = 0
Combo3.ListIndex = 0
prevWndProc = GetWindowLong(Text1.hwnd, GWL_WNDPROC)
SetWindowLong Text1.hwnd, GWL_WNDPROC, AddressOf WndProc
'
End Sub
Private Sub Timer1_Timer()
On Error Resume Next
Text2.Text = Val(Text1.Text) + 1
End Sub
'下面的代码可以关闭所有打开的 DAO workspace，并释放所占的内存。
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
MAIN.Enabled = True
Dim ws As Workspace
Dim db As Database
Dim rs As Recordset
For Each ws In Workspaces
For Each db In ws.Databases
For Each rs In db.Recordsets
rs.Close
Set rs = Nothing
Next
db.Close
Set db = Nothing
Next
ws.Close
Set ws = Nothing
Next
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -