📄 form_accountv.frm
字号:
Left = 6900
TabIndex = 16
Top = 3690
Width = 540
End
Begin VB.Label Label20
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "类别号"
Height = 180
Left = 4065
TabIndex = 15
Top = 3690
Width = 540
End
Begin VB.Label Label17
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "专业号"
Height = 180
Left = 5730
TabIndex = 14
Top = 1815
Visible = 0 'False
Width = 540
End
Begin VB.Label Label16
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "流水号"
Height = 180
Left = 5640
TabIndex = 13
Top = 2250
Visible = 0 'False
Width = 540
End
Begin VB.Label Label14
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "著录时间"
Height = 180
Left = 3990
TabIndex = 12
Top = 5475
Width = 720
End
Begin VB.Label Label13
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "著录者"
Height = 180
Left = 510
TabIndex = 11
Top = 5445
Width = 540
End
Begin VB.Label Label12
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "终止时间"
Height = 180
Left = 3990
TabIndex = 10
Top = 2865
Width = 720
End
Begin VB.Label Label11
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "保管期限"
Height = 180
Left = 510
TabIndex = 9
Top = 3330
Width = 720
End
Begin VB.Label Label10
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "总页数"
ForeColor = &H00000000&
Height = 180
Left = 4170
TabIndex = 8
Top = 1050
Width = 540
End
Begin VB.Label Label9
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "凭证编号"
Height = 180
Left = 510
TabIndex = 7
Top = 2400
Width = 720
End
Begin VB.Label Label8
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "起始时间"
Height = 180
Left = 510
TabIndex = 6
Top = 2865
Width = 720
End
Begin VB.Label Label7
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "卷(册、袋)标题"
ForeColor = &H000000C0&
Height = 180
Left = 510
TabIndex = 5
Top = 1520
Width = 1260
End
Begin VB.Label Label6
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "归档年份"
ForeColor = &H000000C0&
Height = 180
Left = 510
TabIndex = 4
Top = 1950
Width = 720
End
Begin VB.Label Label5
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "备注"
Height = 180
Left = 510
TabIndex = 3
Top = 4245
Width = 360
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "类别"
Height = 180
Left = 510
TabIndex = 2
Top = 1060
Width = 360
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "室编档号"
ForeColor = &H000000C0&
Height = 180
Left = 510
TabIndex = 1
Top = 600
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Combo4.AddItem ""其它"""
BeginProperty Font
Name = "隶书"
Size = 18
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 3150
TabIndex = 0
Top = 60
Width = 3780
End
End
Attribute VB_Name = "form_AccountV"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim strfile As String
Private Sub Combo1_Click()
If Combo1.ListIndex = 0 Then
Combo1.ListIndex = 1
End If
End Sub
Private Sub Combo1_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub
Private Sub Combo2_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub
Private Sub Command1_Click()
On Error GoTo e:
'form_PK.Show 1
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 A4 = "A4" Then
If Right(App.Path, 1) = "\" Then
strSource = App.Path & "excel\grid.xls"
strDestination = App.Path & "excel\temp.xls"
Else
strSource = App.Path & "\excel\grid.xls"
strDestination = App.Path & "\excel\temp.xls"
End If
' ElseIf A4 = "16K" Then
' strSource = App.Path & "\excel2\grid.xls"
' strDestination = App.Path & "\excel2\temp.xls"
' End If
FileCopy strSource, strDestination
Set xlbook = xlapp.Workbooks.Open(strDestination)
Set xlsheet = xlbook.Worksheets(1)
If Text2.text = fondsCode Then
xlsheet.Cells(1, 1) = fondsName
Else
xlsheet.Cells(1, 1) = fondsName2
End If
'xlsheet.Cells(2, 1) = Text9.text
xlsheet.Cells(3, 1) = " " & Text9.text
xlsheet.Cells(4, 1) = " " & Mid(Format(DTPicker1.Value, "yyyy-mm-dd"), 1, 4) & " " & Mid(Format(DTPicker1.Value, "yyyy-mm-dd"), 6, 2) & " " & Mid(Format(DTPicker2.Value, "yyyy-mm-dd"), 1, 4) & " " & Mid(Format(DTPicker2.Value, "yyyy-mm-dd"), 6, 2)
xlsheet.Cells(4, 3) = " " & Combo2.text
'xlsheet.Cells(5, 1) = " " & Text8.text
xlsheet.Cells(5, 3) = " " & Text1.text
Set xlsheet = xlbook.Worksheets(2)
'xlsheet.Cells(1, 1) = "卷内文件目录"
lop = 3
With ListView2.ListItems
For numi = 1 To .Count
xlsheet.Cells(lop, 1) = .Item(numi)
For numj = 1 To ListView2.ColumnHeaders.Count - 1
If numj <> 4 Then
xlsheet.Cells(lop, numj + 1) = .Item(numi).SubItems(numj) '打印列
End If
If numj = 4 Then
xlsheet.Cells(lop, 5) = .Item(numi).SubItems(numj - 1) '责任者题名互换
End If
If numj = 5 Then
xlsheet.Cells(lop, 4) = .Item(numi).SubItems(numj - 1)
End If
Next numj
lop = lop + 1
Next numi
Dim isum, iprint As Integer
isum = .Count
iprint = isum Mod 15
If iprint <> 0 Then
iprint = 15 - iprint
For numj = 1 To iprint
xlsheet.Cells(lop, 1) = "'"
lop = lop + 1
Next numj
End If
'打印空行
End With
Set xlsheet = xlbook.Worksheets(3)
xlsheet.Cells(2, 3) = ""
xlsheet.Cells(3, 3) = ""
xlsheet.Cells(4, 3) = ""
xlsheet.Cells(18, 3) = ""
xlsheet.Cells(20, 3) = ""
xlsheet.Cells(21, 3) = ""
xlsheet.Cells(22, 3) = ""
xlsheet.Cells(23, 3) = ""
xlsheet.Cells(2, 4) = Text2.text + "-" + Text3.text + "-" + Text6.text + "-" + Text4.text + "-" + Text5.text
xlsheet.Cells(3, 4) = Text1.text
xlsheet.Cells(4, 4) = ""
xlsheet.Cells(18, 4) = "'" + Text9.text
xlsheet.Cells(20, 4) = "'"
xlsheet.Cells(21, 4) = "'" + CStr(DTPicker3.Value)
xlsheet.Cells(22, 4) = Combo2.text
xlsheet.Cells(23, 4) = Combo1.text
xlapp.Visible = True
'xlsheet.PrintOut '执行打印
xlbook.Save '保存文件
'xlapp.quit '退出Excel
Screen.MousePointer = vbDefault
Exit Sub
e:
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -