📄 form_print.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form form_Print
BorderStyle = 1 'Fixed Single
ClientHeight = 6705
ClientLeft = 45
ClientTop = 330
ClientWidth = 11250
KeyPreview = -1 'True
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
Picture = "form_Print.frx":0000
ScaleHeight = 6705
ScaleWidth = 11250
StartUpPosition = 2 'CenterScreen
Begin VB.CommandButton Command2
Cancel = -1 'True
Height = 315
Left = 5820
Picture = "form_Print.frx":2209F
Style = 1 'Graphical
TabIndex = 3
Top = 6150
Width = 1065
End
Begin VB.CommandButton Command1
Height = 315
Left = 4290
Picture = "form_Print.frx":22177
Style = 1 'Graphical
TabIndex = 2
Top = 6150
Width = 1065
End
Begin MSComctlLib.ListView ListView1
Height = 4965
Left = 330
TabIndex = 1
Top = 990
Width = 10575
_ExtentX = 18653
_ExtentY = 8758
LabelWrap = -1 'True
HideSelection = -1 'True
AllowReorder = -1 'True
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 0
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
BeginProperty Font
Name = "隶书"
Size = 18
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 2130
TabIndex = 0
Top = 360
Width = 180
End
End
Attribute VB_Name = "form_Print"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
On Error GoTo e:
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
Dim isum, iprint As Integer '打印空行
Screen.MousePointer = vbHourglass
Set xlapp = CreateObject("Excel.Application")
xlapp.Visible = False
Select Case form_AnJuan.List1.ListIndex
Case 0
'MsgBox "文书档案" '0
Case 15, 16, 17, 19, 20, 21, 22, 23, 24, 25, 26
'MsgBox "专业档案" '1
Case 10, 18
'会计档案
If Right(App.Path, 1) = "\" Then
strSource = App.Path & "excel\accountv.xls"
strDestination = App.Path & "excel\temp.xls"
Else
strSource = App.Path & "\excel\accountv.xls"
strDestination = App.Path & "\excel\temp.xls"
End If
FileCopy strSource, strDestination
Set xlbook = xlapp.Workbooks.Open(strDestination)
Set xlsheet = xlbook.Worksheets(1)
lop = 3
'xlsheet.Cells(1, 1) = "类别:" + Label1.Caption
' For numj = 1 To ListView1.ColumnHeaders.Count
' xlsheet.Cells(2, numj) = ListView1.ColumnHeaders.Item(numj).Text
' Next numj
With ListView1.ListItems
For numi = 1 To .Count
xlsheet.Cells(lop, 1) = .Item(numi)
For numj = 1 To ListView1.ColumnHeaders.Count - 2
xlsheet.Cells(lop, numj + 1) = .Item(numi).SubItems(numj) '打印列
If form_QueryV.JG = "y" Then
xlsheet.Cells(lop, 1) = .Item(numi).SubItems(ListView1.ColumnHeaders.Count - 1)
End If
Next numj
lop = lop + 1
Next numi
isum = .Count
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 With
Case 11
'实物档案
If Right(App.Path, 1) = "\" Then
strSource = App.Path & "excel\shiwuv.xls"
strDestination = App.Path & "excel\temp.xls"
Else
strSource = App.Path & "\excel\shiwuv.xls"
strDestination = App.Path & "\excel\temp.xls"
End If
FileCopy strSource, strDestination
Set xlbook = xlapp.Workbooks.Open(strDestination)
Set xlsheet = xlbook.Worksheets(1)
lop = 4
'xlsheet.Cells(1, 1) = "类别:" + Label1.Caption
' For numj = 1 To ListView1.ColumnHeaders.Count
' xlsheet.Cells(2, numj) = ListView1.ColumnHeaders.Item(numj).Text
' Next numj
If form_QueryV.Combo3.text <> "" Then
xlsheet.Cells(1, 1) = "类别:---" + form_QueryV.Combo3.text
End If
With ListView1.ListItems
For numi = 1 To .Count
xlsheet.Cells(lop, 1) = .Item(numi)
For numj = 1 To ListView1.ColumnHeaders.Count - 2
xlsheet.Cells(lop, numj + 1) = .Item(numi).SubItems(numj) '打印列
If numj = 1 Then
xlsheet.Cells(lop, numj + 1) = ""
End If
xlsheet.Cells(lop, 2) = .Item(numi).SubItems(8)
Next numj
lop = lop + 1
Next numi
isum = .Count
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 With
Case 13
'电子档案
If Right(App.Path, 1) = "\" Then
strSource = App.Path & "excel\dzda.xls"
strDestination = App.Path & "excel\temp.xls"
Else
strSource = App.Path & "\excel\dzda.xls"
strDestination = App.Path & "\excel\temp.xls"
End If
FileCopy strSource, strDestination
Set xlbook = xlapp.Workbooks.Open(strDestination)
Set xlsheet = xlbook.Worksheets(1)
lop = 3
'xlsheet.Cells(1, 1) = "类别:" + Label1.Caption
' For numj = 1 To ListView1.ColumnHeaders.Count
' xlsheet.Cells(2, numj) = ListView1.ColumnHeaders.Item(numj).Text
' Next numj
With ListView1.ListItems
For numi = 1 To .Count
xlsheet.Cells(lop, 1) = .Item(numi)
For numj = 1 To ListView1.ColumnHeaders.Count - 1
xlsheet.Cells(lop, numj + 1) = .Item(numi).SubItems(numj) '打印列
Next numj
lop = lop + 1
Next numi
isum = .Count
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 With
Case 7
'MsgBox "---照片档案" '2
Case 8, 9
'MsgBox "---音、视频档案" '3
If Right(App.Path, 1) = "\" Then
strSource = App.Path & "excel\mediav.xls"
strDestination = App.Path & "excel\temp.xls"
Else
strSource = App.Path & "\excel\mediav.xls"
strDestination = App.Path & "\excel\temp.xls"
End If
FileCopy strSource, strDestination
Set xlbook = xlapp.Workbooks.Open(strDestination)
Set xlsheet = xlbook.Worksheets(1)
lop = 3
'xlsheet.Cells(1, 1) = "类别:" + Label1.Caption
' For numj = 1 To ListView1.ColumnHeaders.Count
' xlsheet.Cells(2, numj) = ListView1.ColumnHeaders.Item(numj).Text
' Next numj
With ListView1.ListItems
For numi = 1 To .Count
xlsheet.Cells(lop, 1) = .Item(numi)
For numj = 1 To ListView1.ColumnHeaders.Count - 2
xlsheet.Cells(lop, numj + 1) = .Item(numi).SubItems(numj) '打印列
If form_QueryV.JG = "y" Then
xlsheet.Cells(lop, 1) = .Item(numi).SubItems(ListView1.ColumnHeaders.Count - 1)
End If
Next numj
lop = lop + 1
Next numi
isum = .Count
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 With
Case 2, 3, 4, 5
'MsgBox "科技档案" '19
If Right(App.Path, 1) = "\" Then
strSource = App.Path & "excel\kejiv.xls"
strDestination = App.Path & "excel\temp.xls"
Else
strSource = App.Path & "\excel\kejiv.xls"
strDestination = App.Path & "\excel\temp.xls"
End If
FileCopy strSource, strDestination
Set xlbook = xlapp.Workbooks.Open(strDestination)
Set xlsheet = xlbook.Worksheets(1)
lop = 4
If form_AnJuan.List1.ListIndex = 25 Then
xlsheet.Cells(1, 1) = "类别:土地批租"
Else
xlsheet.Cells(1, 1) = "类别:" + Mid(Label1.Caption, 2, 4)
End If
If form_AnJuan.List1.ListIndex = 22 Or form_AnJuan.List1.ListIndex = 23 Or form_AnJuan.List1.ListIndex = 25 Then
xlsheet.Cells(1, 3) = "案 卷 目 录 "
End If
' For numj = 1 To ListView1.ColumnHeaders.Count
' xlsheet.Cells(2, numj) = ListView1.ColumnHeaders.Item(numj).Text
' Next numj
With ListView1.ListItems
For numi = 1 To .Count
xlsheet.Cells(lop, 1) = .Item(numi)
For numj = 1 To ListView1.ColumnHeaders.Count - 2
xlsheet.Cells(lop, numj + 1) = .Item(numi).SubItems(numj) '打印列
If form_QueryV.JG = "y" Then
xlsheet.Cells(lop, 1) = .Item(numi).SubItems(ListView1.ColumnHeaders.Count - 1)
End If
Next numj
lop = lop + 1
Next numi
isum = .Count
iprint = isum Mod 8
If iprint <> 0 Then
iprint = 8 - iprint
For numj = 1 To iprint
xlsheet.Cells(lop, 1) = "'"
lop = lop + 1
Next numj
End If
'打印空行
End With
Case Else
MsgBox "请选择小类档案", vbInformation, ""
Exit Sub
End Select
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 Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
Label1.Caption = form_AnJuan.Label4.Caption + "目录"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -