📄 form_queryv.frm
字号:
.View = lvwReport
.ListItems.Clear
rs.Open strSql, conn
While Not rs.EOF
i = i + 1
Set itmX = .ListItems.Add(, , xml("REFERENCE_CODE_OF_FILE_OFFICE"))
itmX.SubItems(1) = xml("SUBORDINATE_TITLE")
itmX.SubItems(2) = xml("DATE_BEGUN")
itmX.SubItems(3) = xml("medium_TYPE")
If Not (form_AnJuan.List1.ListIndex = 13 Or form_AnJuan.List1.ListIndex = 10) Then
Combo2.ListIndex = xml("RETENTION_PERIOD") + 1
Else
Combo2.text = xml("RETENTION_PERIOD")
End If
itmX.SubItems(4) = xml("REFERENCED_CODE")
itmX.SubItems(5) = xml("MEDIUM_CODE")
itmX.SubItems(6) = Combo2.text
itmX.SubItems(7) = xml("NOTES_OF_ARCHIVIST")
rs.MoveNext
Wend
rs.Close
End With
form_Print.Show 1
Case Else
MsgBox "请选择小类档案", vbInformation, ""
Exit Sub
End Select
Unload Me
Exit Sub
e:
'MsgBox Err.Number & Err.Description, vbExclamation, ""
MsgBox "请输入正确的数据格式！", 64, ""
If rs.State = 1 Then
rs.Close
End If
End Sub
Private Sub Command12_Click()
queryflag = "no"
JG.Caption = "n"
Select Case form_AnJuan.List1.ListIndex
Case 0, 7, 12, 15, 16, 17, 19, 20, 21, 22, 23, 24, 25, 26
Case Else
Call Command1_Click
Exit Sub
End Select
'On Error GoTo e:
Call Command1_Click
Dim xlapp As Object, xlbook As Object, xlsheet As Object
'Dim xlapp As Object, xlbook As Object, xlsheet As Object
Dim strSource, strDestination As String
Dim lop As Integer
Dim numi, numj As Integer
''Dim xlbook As Excel.Workbook
''Dim xlsheet As Excel.Worksheet
Screen.MousePointer = vbHourglass
Set xlapp = CreateObject("Excel.Application")
xlapp.Visible = False
If Right(App.Path, 1) = "\" Then
strSource = App.Path & "excel\gridV.xls"
strDestination = App.Path & "excel\temp.xls"
Else
strSource = App.Path & "\excel\gridV.xls"
strDestination = App.Path & "\excel\temp.xls"
End If
FileCopy strSource, strDestination
Set xlbook = xlapp.Workbooks.Open(strDestination)
Set xlsheet = xlbook.Worksheets(3)
lop = 4
If form_AnJuan.List1.ListIndex <> 0 Then
xlsheet.Cells(1, 1) = "类别:" + form_AnJuan.List1.text
End If
' For numj = 1 To ListView1.ColumnHeaders.Count
' xlsheet.Cells(2, numj) = ListView1.ColumnHeaders.Item(numj).Text
' Next numj
With form_AnJuan.ListView1.ListItems
For numi = 1 To .Count
'xlsheet.Cells(lop, 1) = .Item(numi)
For numj = 1 To form_AnJuan.ListView1.ColumnHeaders.Count - 2
xlsheet.Cells(lop, numj + 1) = "'" + .Item(numi).SubItems(numj) '打印列
If numj = 2 Then
xlsheet.Cells(lop, 1) = "'" + .Item(numi).SubItems(numj)
xlsheet.Cells(lop, numj + 1) = ""
End If
If .Item(numi).SubItems(8) <> "-0001" Then
If form_AnJuan.List1.ListIndex = 0 Then
xlsheet.Cells(lop, 3) = "'" + Format(.Item(numi).SubItems(8), "0000")
Else
xlsheet.Cells(lop, 3) = "'" + .Item(numi).SubItems(8)
End If
End If
Next numj
lop = lop + 1
Next numi
Dim isum, iprint As Integer
isum = .Count
If isum > 7 Then
iprint = isum Mod 7
If iprint <> 0 Then
iprint = 7 - iprint
For numj = 1 To iprint
xlsheet.Cells(lop, 1) = "'"
lop = lop + 1
Next numj
End If
End If
End With
xlapp.Visible = True
'xlsheet.PrintOut '执行打印
xlbook.Save '保存文件
'xlapp.quit '退出Excel
Screen.MousePointer = vbDefault
Exit Sub
e:
MsgBox Err.Description + Err.Number
Screen.MousePointer = vbDefault
Set xlapp = Nothing
Set xlbook = Nothing
Set xlsheet = Nothing
End Sub
Private Sub Command2_Click()
queryflag = "no"
JG.Caption = "y"
Select Case form_AnJuan.List1.ListIndex
Case 0, 7, 12, 15, 16, 17, 19, 20, 21, 22, 23, 24, 25, 26
Case Else
Call Command1_Click
Exit Sub
End Select
'On Error GoTo e:
Call Command1_Click
Dim xlapp As Object, xlbook As Object, xlsheet As Object
Dim strSource, strDestination As String
Dim lop As Integer
Dim numi, numj As Integer
'Dim xlbook As Excel.Workbook
'Dim xlsheet As Excel.Worksheet
Screen.MousePointer = vbHourglass
Set xlapp = CreateObject("Excel.Application")
xlapp.Visible = False
If Right(App.Path, 1) = "\" Then
strSource = App.Path & "excel\gridV.xls"
strDestination = App.Path & "excel\temp.xls"
Else
strSource = App.Path & "\excel\gridV.xls"
strDestination = App.Path & "\excel\temp.xls"
End If
FileCopy strSource, strDestination
Set xlbook = xlapp.Workbooks.Open(strDestination)
Set xlsheet = xlbook.Worksheets(3)
lop = 4
If form_AnJuan.List1.ListIndex <> 0 Then
xlsheet.Cells(1, 1) = "类别:" + form_AnJuan.List1.text
End If
' For numj = 1 To ListView1.ColumnHeaders.Count
' xlsheet.Cells(2, numj) = ListView1.ColumnHeaders.Item(numj).Text
' Next numj
With form_AnJuan.ListView1.ListItems
For numi = 1 To .Count
'xlsheet.Cells(lop, 1) = .Item(numi)
For numj = 1 To form_AnJuan.ListView1.ColumnHeaders.Count - 2
xlsheet.Cells(lop, numj + 1) = "'" + .Item(numi).SubItems(numj) '打印列
If numj = 2 Then
xlsheet.Cells(lop, 1) = "'" + .Item(numi).SubItems(numj)
xlsheet.Cells(lop, numj + 1) = ""
End If
If .Item(numi).SubItems(8) <> "-0001" Then
If form_AnJuan.List1.ListIndex = 0 Then
xlsheet.Cells(lop, 3) = "'" + Format(.Item(numi).SubItems(8), "0000")
Else
xlsheet.Cells(lop, 3) = "'" + .Item(numi).SubItems(8)
End If
End If
Next numj
lop = lop + 1
Next numi
Dim isum, iprint As Integer
isum = .Count
If isum > 7 Then
iprint = isum Mod 7
If iprint <> 0 Then
iprint = 7 - iprint
For numj = 1 To iprint
xlsheet.Cells(lop, 1) = "'"
lop = lop + 1
Next numj
End If
End If
End With
xlapp.Visible = True
'xlsheet.PrintOut '执行打印
xlbook.Save '保存文件
'xlapp.quit '退出Excel
Screen.MousePointer = vbDefault
Exit Sub
e:
MsgBox Err.Description
Screen.MousePointer = vbDefault
Set xlapp = Nothing
Set xlbook = Nothing
Set xlsheet = Nothing
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys "{tab}"
KeyAscii = 0
End If
End Sub
Private Sub Form_Load()
backColor = bgColor
Label4.Caption = form_AnJuan.Label4.Caption + "编目查询"
Text1.text = ""
Text2.text = ""
Text3.text = ""
Text4.text = ""
Text5.text = ""
Combo1.AddItem ""
Combo1.AddItem "公开"
Combo1.AddItem "限制"
Combo1.AddItem "秘密"
Combo1.AddItem "机密"
Combo1.ListIndex = 0
Combo2.AddItem ""
Combo2.AddItem "永久"
Combo2.AddItem "长期"
Combo2.AddItem "短期"
Combo2.ListIndex = 0
Combo3.AddItem ""
Combo3.AddItem "文本"
Combo3.AddItem "图像"
Combo3.AddItem "图形"
Combo3.AddItem "影像"
Combo3.AddItem "声音"
Combo3.AddItem "程序文件"
Combo3.AddItem "数据文件"
Combo3.AddItem "超媒体链接文件"
Combo3.ListIndex = 0
'电子档案信息类型
Select Case form_AnJuan.List1.ListIndex
Case 0
'MsgBox "文书档案" '0
Case 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26
'MsgBox "专业档案" '1
Case 10
'会计档案
Label3.Visible = False
Text3.Visible = False
Combo2.Clear
Combo2.AddItem ""
Combo2.AddItem "3年"
Combo2.AddItem "5年"
Combo2.AddItem "10年"
Combo2.AddItem "15年"
Combo2.AddItem "25年"
Combo2.AddItem "永久"
Combo2.ListIndex = 0
Case 11
'实物档案
Label3.Visible = False
Text3.Visible = False
Combo1.Visible = False
Label7.Visible = False
Label9.Visible = True
Combo3.Visible = True
Label9.Caption = "类别"
Combo3.Clear
Combo3.AddItem ""
Combo3.AddItem "奖状"
Combo3.AddItem "证书"
Combo3.AddItem "奖杯"
Combo3.AddItem "锦旗"
Combo3.AddItem "铜牌"
Combo3.AddItem "字画"
Combo3.AddItem "其他"
Combo3.ListIndex = 0
Case 12
'人物档案
Case 13
'电子档案
Label9.Visible = True
Combo3.Visible = True
Combo2.Clear
Combo2.AddItem ""
Combo2.AddItem "3年"
Combo2.AddItem "5年"
Combo2.AddItem "10年"
Combo2.AddItem "15年"
Combo2.AddItem "25年"
Combo2.AddItem "永久"
Combo2.ListIndex = 0
Case 7
'MsgBox "---照片档案" '2
Case 8, 9
'MsgBox "---音、视频档案" '3
Case 2, 3, 4, 5
'MsgBox "科技档案" '19
Case Else
'Unload Me
End Select
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If Not (KeyAscii > 47 And KeyAscii < 59) And KeyAscii <> 8 Then
KeyAscii = 0
MsgBox "请输入数字!", 48, ""
End If
End Sub
Private Sub Text4_KeyPress(KeyAscii As Integer)
If Not (KeyAscii > 47 And KeyAscii < 59) And KeyAscii <> 8 Then
KeyAscii = 0
MsgBox "请输入数字!", 48, ""
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -