📄
字号:
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 KF_FrmStartEnd
BorderStyle = 3 'Fixed Dialog
Caption = "期初结帐"
ClientHeight = 3885
ClientLeft = 45
ClientTop = 330
ClientWidth = 4125
HelpContextID = 1212005
Icon = "期初_期初单据记帐.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3885
ScaleWidth = 4125
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin TabDlg.SSTab SSTab1
Height = 3315
Left = 30
TabIndex = 0
Top = 0
Width = 4095
_ExtentX = 7223
_ExtentY = 5847
_Version = 393216
Style = 1
Tabs = 2
TabHeight = 520
TabCaption(0) = "期初结帐"
TabPicture(0) = "期初_期初单据记帐.frx":1042
Tab(0).ControlEnabled= -1 'True
Tab(0).Control(0)= "Frame1(0)"
Tab(0).Control(0).Enabled= 0 'False
Tab(0).ControlCount= 1
TabCaption(1) = "恢复期初结帐"
TabPicture(1) = "期初_期初单据记帐.frx":105E
Tab(1).ControlEnabled= 0 'False
Tab(1).Control(0)= "Frame1(1)"
Tab(1).ControlCount= 1
Begin VB.Frame Frame1
Height = 2805
Index = 1
Left = -74850
TabIndex = 7
Top = 390
Width = 3765
Begin VB.CommandButton QdQuitU
Caption = "退出"
Height = 330
Left = 2490
TabIndex = 11
Top = 1890
Width = 1125
End
Begin VB.CommandButton QdOkU
Caption = "恢复结帐"
Height = 330
Left = 2490
TabIndex = 10
Top = 1320
Width = 1125
End
Begin VB.CommandButton QdAllU
Caption = "全选"
Height = 330
Left = 2490
TabIndex = 9
Tag = "全消"
Top = 750
Width = 1125
End
Begin VB.ListBox Lst_Uncheck
Height = 2160
Left = 120
Style = 1 'Checkbox
TabIndex = 8
Top = 450
Width = 2235
End
End
Begin VB.Frame Frame1
Height = 2805
Index = 0
Left = 150
TabIndex = 1
Top = 390
Width = 3765
Begin VB.ListBox Lst_Check
Height = 2160
Left = 120
Style = 1 'Checkbox
TabIndex = 5
Top = 450
Width = 2235
End
Begin VB.CommandButton QdAll
Caption = "全选"
Height = 330
Left = 2490
TabIndex = 4
Tag = "全消"
Top = 750
Width = 1120
End
Begin VB.CommandButton QdOk
Caption = "结帐"
Height = 330
Left = 2490
TabIndex = 3
Top = 1320
Width = 1120
End
Begin VB.CommandButton QdQuit
Caption = "退出"
Height = 330
Left = 2490
TabIndex = 2
Top = 1890
Width = 1120
End
End
End
Begin MSComctlLib.ProgressBar PB
Height = 225
Left = 90
TabIndex = 6
Top = 3630
Width = 3945
_ExtentX = 6959
_ExtentY = 397
_Version = 393216
Appearance = 1
MousePointer = 13
Scrolling = 1
End
Begin VB.Label Lb
AutoSize = -1 'True
BackStyle = 0 'Transparent
Height = 180
Left = 1410
TabIndex = 12
Top = 3420
Width = 90
End
End
Attribute VB_Name = "KF_FrmStartEnd"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*****************************************************************
' 模块名称：期初单据结帐
' 模块功能：期初单据结帐
' 编 制 者：张万成
' 编制日期：2001/11/27
' 备 注：
'*****************************************************************
Dim adoWare As New ADODB.Recordset
Dim Tsxx As String
Dim strWhCode() As String
Dim strWh As String
Dim bls As Boolean
Public Function FillHouse(BType As Integer) As Boolean
Set adoWare = Cw_DataEnvi.DataConnect.Execute("KF_SP_InitWareHouse '" & Trim(Xtczybm) & "'," & BType)
End Function
Private Sub FillWare(L As ListBox) '填充仓库
Dim i As Integer
ReDim strWhCode(adoWare.RecordCount)
L.Clear
With L
For i = 0 To adoWare.RecordCount - 1
.AddItem Trim(adoWare.Fields("whcode")) + "-" + Trim(adoWare.Fields("whname"))
strWhCode(i) = Trim(adoWare.Fields("whcode"))
adoWare.MoveNext
Next i
End With
End Sub
Private Sub Form_Load()
If Not FillHouse(1) Then
Call FillWare(Lst_Check)
End If
PB.Visible = False
Me.Height = Me.Height - 500
End Sub
Private Sub QdAll_Click()
If QdAll.Caption = "全选" Then
QdAll.Tag = "全消"
For i = 0 To Lst_Check.ListCount - 1
Lst_Check.Selected(i) = True
Next i
Else
For i = 0 To Lst_Check.ListCount - 1
Lst_Check.Selected(i) = False
Next i
End If
StrTemp = QdAll.Caption
QdAll.Caption = QdAll.Tag
QdAll.Tag = StrTemp
End Sub
Private Sub QdAllU_Click()
If QdAllU.Caption = "全选" Then
QdAllU.Tag = "全消"
For i = 0 To Lst_Uncheck.ListCount - 1
Lst_Uncheck.Selected(i) = True
Next i
Else
For i = 0 To Lst_Uncheck.ListCount - 1
Lst_Uncheck.Selected(i) = False
Next i
End If
StrTemp = QdAllU.Caption
QdAllU.Caption = QdAllU.Tag
QdAllU.Tag = StrTemp
End Sub
Private Sub QdOk_Click() '结帐
If Not B_Status(Lst_Check) Then
Tsxx = "您没有选仓库,请先选择!"
Call Xtxxts(Tsxx, 0, 1)
Exit Sub
End If
On Error GoTo Swcwcl
Me.Height = Me.Height + 500
Me.Refresh
PB.Visible = True
PB.Max = Lst_Check.ListCount
PB.Min = 0: PB.Value = 0
Cw_DataEnvi.DataConnect.BeginTrans
For i = 0 To Lst_Check.ListCount - 1
If Lst_Check.Selected(i) Then
Cw_DataEnvi.DataConnect.Execute ("KF_SP_StartCheck '" & Trim(strWhCode(i)) & "','" & Xtczy & "',1")
End If
PB.Value = i + 1
Lb.Caption = "已完成" & CStr(Int(PB.Value * 100 / PB.Max)) & "%"
Lb.Refresh
Next i
Cw_DataEnvi.DataConnect.CommitTrans
Tsxx = "结帐成功!"
Call Xtxxts(Tsxx, 0, 4)
If Not FillHouse(1) Then
Call FillWare(Lst_Check)
End If
Lb.Caption = ""
PB.Visible = False
Me.Height = Me.Height - 500
Exit Sub
Swcwcl:
Cw_DataEnvi.DataConnect.RollbackTrans
Tsxx = "结帐失败,系统恢复到初始状态!"
Call Xtxxts(Tsxx, 0, 1)
Me.Height = Me.Height - 500
Exit Sub
End Sub
Private Sub QdOkU_Click() '恢复结帐
If Not B_Status(Lst_Uncheck) Then
Tsxx = "您没有选仓库,请先选择!"
Call Xtxxts(Tsxx, 0, 1)
Exit Sub
End If
On Error GoTo Swcwcl
Me.Height = Me.Height + 500
Me.Refresh
PB.Visible = True
PB.Max = Lst_Uncheck.ListCount
PB.Min = 0: PB.Value = 0
Cw_DataEnvi.DataConnect.BeginTrans
For i = 0 To Lst_Uncheck.ListCount - 1
If Lst_Uncheck.Selected(i) Then
Cw_DataEnvi.DataConnect.Execute ("KF_SP_StartCheck '" & Trim(strWhCode(i)) & "','" & Xtczy & "',0")
End If
PB.Value = i + 1
Lb.Caption = "已完成" & CStr(Int(PB.Value * 100 / PB.Max)) & "%"
Lb.Refresh
Next i
Cw_DataEnvi.DataConnect.CommitTrans
Tsxx = "恢复结帐成功!"
Call Xtxxts(Tsxx, 0, 4)
If Not FillHouse(0) Then
Call FillWare(Lst_Uncheck)
End If
Lb.Caption = ""
PB.Visible = False
Me.Height = Me.Height - 500
Exit Sub
Swcwcl:
Cw_DataEnvi.DataConnect.RollbackTrans
Tsxx = "恢复结帐失败,系统恢复到初始状态!"
Call Xtxxts(Tsxx, 0, 1)
Me.Height = Me.Height - 500
Exit Sub
End Sub
Private Sub QdQuit_Click()
Unload Me
End Sub
Private Sub QdQuitU_Click()
Unload Me
End Sub
Private Sub SSTab1_Click(PreviousTab As Integer)
If SSTab1.Tab = 1 Then
QdAllU.Caption = "全选"
Call FillHouse(0)
Call FillWare(Lst_Uncheck)
Else
QdAll.Caption = "全选"
Call FillHouse(1)
Call FillWare(Lst_Check)
End If
End Sub
Private Function B_Status(L As ListBox) As Boolean
For i = 0 To L.ListCount - 1
B_Status = B_Status Or L.Selected(i)
Next
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -