📄 frmtl_backups.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "tabctl32.ocx"
Begin VB.Form frmTL_BackupS
BorderStyle = 5 'Sizable ToolWindow
Caption = "财务数据备份"
ClientHeight = 5895
ClientLeft = 60
ClientTop = 300
ClientWidth = 6390
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5895
ScaleWidth = 6390
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin TabDlg.SSTab sTb
Height = 5895
Left = 0
TabIndex = 0
Top = 0
Width = 6975
_ExtentX = 12303
_ExtentY = 10398
_Version = 393216
TabOrientation = 3
Style = 1
TabHeight = 520
WordWrap = 0 'False
TabCaption(0) = "Tab 0"
TabPicture(0) = "frmTL_BackupS.frx":0000
Tab(0).ControlEnabled= -1 'True
Tab(0).Control(0)= "Picture2"
Tab(0).Control(0).Enabled= 0 'False
Tab(0).Control(1)= "Frame1"
Tab(0).Control(1).Enabled= 0 'False
Tab(0).Control(2)= "cmdNext1"
Tab(0).Control(2).Enabled= 0 'False
Tab(0).Control(3)= "cmdCancel1"
Tab(0).Control(3).Enabled= 0 'False
Tab(0).ControlCount= 4
TabCaption(1) = "Tab 1"
TabPicture(1) = "frmTL_BackupS.frx":001C
Tab(1).ControlEnabled= 0 'False
Tab(1).Control(0)= "Label1"
Tab(1).Control(0).Enabled= 0 'False
Tab(1).Control(1)= "lblMsg"
Tab(1).Control(1).Enabled= 0 'False
Tab(1).Control(2)= "lstResult"
Tab(1).Control(2).Enabled= 0 'False
Tab(1).Control(3)= "cmdPrevious2"
Tab(1).Control(3).Enabled= 0 'False
Tab(1).Control(4)= "cmdCancel2"
Tab(1).Control(4).Enabled= 0 'False
Tab(1).Control(5)= "cmdOK"
Tab(1).Control(5).Enabled= 0 'False
Tab(1).ControlCount= 6
TabCaption(2) = "Tab 2"
TabPicture(2) = "frmTL_BackupS.frx":0038
Tab(2).ControlEnabled= 0 'False
Tab(2).ControlCount= 0
Begin VB.CommandButton cmdOK
Caption = "确定(&O)"
Height = 375
Left = -71760
TabIndex = 13
Top = 4920
Width = 1095
End
Begin VB.CommandButton cmdCancel2
Caption = "退出(&Q)"
Height = 375
Left = -70560
TabIndex = 12
Top = 4920
Width = 1095
End
Begin VB.CommandButton cmdPrevious2
Caption = "上一步(&A)"
Height = 375
Left = -73920
TabIndex = 11
Top = 4920
Width = 975
End
Begin VB.CommandButton cmdCancel1
Caption = "取消(&X)"
Height = 375
Left = 3960
TabIndex = 10
Top = 5160
Width = 975
End
Begin VB.CommandButton cmdNext1
Caption = "下一步(&B)"
Height = 375
Left = 1560
TabIndex = 9
Top = 5160
Width = 975
End
Begin VB.Frame Frame1
Height = 4905
Left = 120
TabIndex = 2
Top = 0
Width = 6170
Begin VB.CommandButton cmdAll
Caption = "全选(&M)"
Height = 300
Left = 5025
TabIndex = 16
Top = 3240
Width = 900
End
Begin VB.Frame Frame2
Height = 135
Left = 25
TabIndex = 4
Top = 3000
Width = 6090
End
Begin VB.ListBox lstTable
Height = 2370
Left = 240
Style = 1 'Checkbox
TabIndex = 3
Top = 600
Width = 2625
End
Begin MSComctlLib.ListView lstMonth
Height = 1065
Left = 240
TabIndex = 5
Top = 3600
Width = 5685
_ExtentX = 10028
_ExtentY = 1879
MultiSelect = -1 'True
LabelWrap = -1 'True
HideSelection = -1 'True
Checkboxes = -1 'True
HotTracking = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 1
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Object.Width = 2540
EndProperty
End
Begin VB.Label lblMemo
AutoSize = -1 'True
Caption = " 注意："
Height = 180
Left = 3000
TabIndex = 8
Top = 600
Width = 3000
WordWrap = -1 'True
End
Begin VB.Label lblMonth
AutoSize = -1 'True
Caption = "选择凭证月份："
ForeColor = &H00C00000&
Height = 180
Left = 240
TabIndex = 7
Top = 3360
Width = 1260
End
Begin VB.Label lblTable
AutoSize = -1 'True
Caption = "请选择需要备份的表："
Height = 180
Left = 240
TabIndex = 6
Top = 360
Width = 1800
End
End
Begin VB.PictureBox Picture2
Height = 5895
Left = 6360
ScaleHeight = 5835
ScaleWidth = 195
TabIndex = 1
Top = 0
Width = 255
End
Begin MSComctlLib.ListView lstResult
Height = 2895
Left = -74520
TabIndex = 17
Top = 1440
Width = 5535
_ExtentX = 9763
_ExtentY = 5106
View = 2
LabelWrap = -1 'True
HideSelection = -1 'True
HideColumnHeaders= -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
NumItems = 1
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "结果"
Object.Width = 2540
EndProperty
End
Begin VB.Label lblMsg
AutoSize = -1 'True
Caption = "提示:正在备份数据，请等候......"
BeginProperty Font
Name = "楷体_GB2312"
Size = 14.25
Charset = 134
Weight = 700
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
Height = 285
Left = -74640
TabIndex = 15
Top = 480
Width = 4935
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "备份情况:"
Height = 180
Left = -74520
TabIndex = 14
Top = 1200
Width = 810
End
End
End
Attribute VB_Name = "frmTL_BackupS"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_aryItem(10) As String
Private m_aryName(10) As String
Private Sub cboYear_Click()
Call FillTable
End Sub
Private Sub cmdAll_Click()
Dim rstTemp As New ADODB.Recordset
Dim i As Integer
Dim sMonth As String
Dim lMonth As Long
Dim sSQL As String
sMonth = ""
lMonth = 0
On Error GoTo HandleErr
With rstTemp
.CursorLocation = adUseClient
sSQL = "Select distinct kjqj from tZW_Pzsj" & glo.sOperateYear & _
" where kjqj<13"
.Open sSQL, glo.cnnMain, adOpenStatic, adLockReadOnly
If .RecordCount > 0 Then
Do Until .EOF
For i = 1 To lstMonth.ListItems.Count
sMonth = Mid(lstMonth.ListItems(i).text, 1, 2)
If IsNumeric(sMonth) Then
lMonth = CLng(sMonth)
Else
lMonth = CLng(Mid(sMonth, 1, 1))
End If
If lMonth = .Fields("kjqj").Value Then
lstMonth.ListItems(i).Checked = True
End If
Next i
.MoveNext
Loop
.Close
Else
MsgBox glo.sOperateYear & "年没有凭证数据！", vbInformation, "提示"
.Close
Exit Sub
End If
End With
Exit Sub
HandleErr:
MsgBox Err.Number & vbTab & Err.Description & vbTab & Err.Source, vbInformation, "提示"
Exit Sub
End Sub
Private Sub cmdCancel1_Click()
Unload Me
End Sub
Private Sub cmdCancel2_Click()
Unload Me
End Sub
Private Sub cmdNext1_Click()
sTb.Tab = 1
cmdOk.Enabled = True
lblMsg.Visible = False
End Sub
Private Sub cmdOk_Click()
Dim i As Integer, j As Integer, k As Integer
Dim iCount As Integer '选择凭证月份的个数
Dim iFlag As Integer '写文件头标志
Dim sFilePath As String
Dim aryTable() As String
Dim sTable As String
Dim aryName() As String
Dim sName As String
Dim sMonth As String
Dim sStr As String
Dim sWhere As String
Dim bErr As Boolean
lblMsg.Caption = "提示:正在备份数据，请等候......"
iCount = 0
For i = 0 To lstTable.ListCount - 1
If lstTable.Selected(i) = True Then
iCount = iCount + 1
End If
Next i
If iCount = 0 Then
MsgBox "请选择需要备份的表！", vbInformation, "提示"
sTb.Tab = 1
Exit Sub
End If
iCount = 0
If lstTable.Selected(2) = True Then
For i = 1 To lstMonth.ListItems.Count
If lstMonth.ListItems(i).Checked = True Then
iCount = iCount + 1
End If
Next i
If iCount = 0 Then
If MsgBox("没有选择凭证月份，将备份该账套下指定年份" & _
"中的全年凭证，数据量很大，继续吗？", vbOKCancel) = vbCancel Then
Exit Sub
End If
End If
End If
iCount = 0
sFilePath = BrowseForFolder(hwnd, "请选择文件保存路径")
If sFilePath <> "" Then
lblMsg.Visible = True
lblMsg.Refresh
cmdOk.Enabled = False
cmdPrevious2.Enabled = False
cmdCancel2.Enabled = False
cmdPrevious2.Refresh
cmdCancel2.Refresh
cmdOk.Refresh
For i = 0 To lstTable.ListCount - 1
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -