📄 frmarrearage.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmArrearage
Caption = "挂帐管理"
ClientHeight = 6015
ClientLeft = 60
ClientTop = 630
ClientWidth = 8820
Icon = "frmArrearage.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MDIChild = -1 'True
ScaleHeight = 6015
ScaleWidth = 8820
WindowState = 2 'Maximized
Begin VB.Frame Frame1
Height = 780
Left = 75
TabIndex = 5
Top = 60
Width = 9495
Begin VB.CommandButton cmdCancel
Cancel = -1 'True
Caption = "关闭(&C)"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 8235
TabIndex = 4
Top = 225
Width = 1275
End
Begin VB.CommandButton cmdPrint
Caption = "打印(&P)"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 6870
TabIndex = 3
ToolTipText = "打印挂帐单列表"
Top = 225
Width = 1275
End
Begin VB.CommandButton cmdToday
Caption = "今日挂帐"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 5610
TabIndex = 2
ToolTipText = "仅显示今日的挂帐"
Top = 225
Width = 1275
End
Begin VB.CommandButton cmdSearch
Caption = "查询(&F)"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 4350
TabIndex = 1
ToolTipText = "查询按扭,查询其它时间段挂帐及会员挂帐。"
Top = 225
Width = 1275
End
Begin VB.CommandButton cmdCheckOut
Caption = "结帐(&H)"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 3090
TabIndex = 0
ToolTipText = "查询按扭,查询其它时间段挂帐及会员挂帐。"
Top = 225
Width = 1275
End
Begin VB.Image Image1
Height = 480
Left = 135
Picture = "frmArrearage.frx":0BC2
Top = 210
Width = 480
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "缺省显示本周挂帐单据？"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00400000&
Height = 240
Index = 0
Left = 750
TabIndex = 6
Top = 345
Width = 1980
End
End
Begin MSComctlLib.ListView lstPro
Height = 3675
Left = 75
TabIndex = 7
ToolTipText = "双击显示消费清单"
Top = 885
Width = 6075
_ExtentX = 10716
_ExtentY = 6482
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = 0 'False
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 = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 11
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "单号"
Object.Width = 1411
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "会员编号"
Object.Width = 2646
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "会员名称"
Object.Width = 2117
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 2
SubItemIndex = 3
Text = "挂帐日期"
Object.Width = 2117
EndProperty
BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 1
SubItemIndex = 4
Text = "时"
Object.Width = 706
EndProperty
BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 5
Text = "分"
Object.Width = 706
EndProperty
BeginProperty ColumnHeader(7) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 1
SubItemIndex = 6
Text = "挂帐金额"
Object.Width = 1764
EndProperty
BeginProperty ColumnHeader(8) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 2
SubItemIndex = 7
Text = "归还日期"
Object.Width = 2117
EndProperty
BeginProperty ColumnHeader(9) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 1
SubItemIndex = 8
Text = "实付金额"
Object.Width = 1587
EndProperty
BeginProperty ColumnHeader(10) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 9
Text = "操作员"
Object.Width = 1587
EndProperty
BeginProperty ColumnHeader(11) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 10
Text = "经办人"
Object.Width = 1587
EndProperty
End
Begin VB.Menu mnuMenuArrearage
Caption = "操作菜单(&M)"
Begin VB.Menu mnuViewArrearage
Caption = "查看挂帐单据明细(&View)"
Shortcut = ^V
End
Begin VB.Menu fasff
Caption = "-"
End
Begin VB.Menu mnuPay
Caption = "结帐(C&heckOut)"
End
Begin VB.Menu dddfdf
Caption = "-"
End
Begin VB.Menu mnuTodayArrearage
Caption = "显示今日挂帐(&Today)"
Shortcut = {F5}
End
Begin VB.Menu mnuWeekArrearage
Caption = "显示本周挂帐(&Week)"
Shortcut = {F6}
End
Begin VB.Menu dafsfdffff
Caption = "-"
End
Begin VB.Menu mnuFindArrearage
Caption = "查询挂帐单(&Find)"
Shortcut = ^F
End
Begin VB.Menu mnuAllArrearage
Caption = "显示所有挂帐单(&All)"
Shortcut = ^A
End
Begin VB.Menu fgggg
Caption = "-"
End
Begin VB.Menu mnuPrintArrearage
Caption = "打印挂帐单(&Print)"
Shortcut = ^P
End
End
End
Attribute VB_Name = "frmArrearage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdCheckOut_Click()
On Error GoTo CheckOutERR
If lstPro.ListItems.Count = 0 Then Exit Sub
If lstPro.SelectedItem.Text = "" Then
MsgBox "请选择任一挂帐单后进行付帐。 ", vbExclamation
lstPro.SetFocus
Exit Sub
End If
If lstPro.SelectedItem.SubItems(8) <> "0" Then
MsgBox "该挂帐单已经结帐，不能再结？ ", vbExclamation
lstPro.SetFocus
Exit Sub
End If
sArrearagePaymethod = ""
'显示付款方式
frmShowPayMethod.Show 1
If sArrearagePaymethod = "" Then
MsgBox "付款方式为空，不能结帐？ ", vbExclamation
Exit Sub
End If
Dim sTmpID As String, sTmpMoney As String, stmpMember As String
sTmpID = lstPro.SelectedItem.Text '消费单号
sTmpMoney = lstPro.SelectedItem.SubItems(6) '金额
stmpMember = lstPro.SelectedItem.SubItems(1) '会员编号
If MsgBox("消费单【" & sTmpID & "】的挂帐金额为（" & sTmpMoney & "元）, " & vbCrLf _
& "现在立即通过『" & sArrearagePaymethod & "』付款吗（是/否） ？ ", vbInformation + vbYesNo) = vbNo Then Exit Sub
'显示结帐信息
Dim sTmp As String
Dim jDB As Connection
Set jDB = CreateObject("ADODB.Connection")
jDB.Open Constr
jDB.BeginTrans
'1/添加付款流水帐
InserToCash jDB, 1, "【" & lstPro.SelectedItem.SubItems(2) & "】付的挂帐款", CCur(sTmpMoney), Date, sArrearagePaymethod
'2/添加到现金表中
InserTodayCash jDB, sArrearagePaymethod, CCur(sTmpMoney), Date
'3/修改挂帐中金额及付款日期
If IsSqlDat = True Then
sTmp = "Update tbdArrearage Set MSFAmount=" & sTmpMoney & ",MReturn=1,MRDate='" & Date & "' Where SheelID=" & sTmpID
Else
sTmp = "Update tbdArrearage Set MSFAmount=" & sTmpMoney & ",MReturn=1,MRDate=#" & Date & "# Where SheelID=" & sTmpID
End If
jDB.Execute sTmp
'4/修改会员的累计消费
UpdateGuestLJ jDB, stmpMember, CCur(sTmpMoney), -CCur(sTmpMoney)
jDB.CommitTrans
jDB.Close
Set jDB = Nothing
MsgBox " 结 帐 完 毕 ！ ", vbInformation
'刷新列表
DisplayArrearageData
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -