📄 thyj.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{50CBA22D-9024-11D1-AD8F-8E94A5273767}#8.6#0"; "TRANIMG2.OCX"
Begin VB.Form THYJ
BorderStyle = 1 'Fixed Single
Caption = "收取团会钥匙押金"
ClientHeight = 3540
ClientLeft = 690
ClientTop = 1740
ClientWidth = 6210
Icon = "THYJ.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3540
ScaleWidth = 6210
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command4
Caption = "离店"
Height = 375
Left = 4920
TabIndex = 6
Top = 240
Visible = 0 'False
Width = 1095
End
Begin VB.CommandButton Command3
Caption = "换房"
Height = 375
Left = 4920
TabIndex = 5
Top = 240
Visible = 0 'False
Width = 1095
End
Begin VB.CommandButton Command2
Caption = "取消"
Default = -1 'True
Height = 375
Left = 4920
TabIndex = 3
Top = 720
Width = 1095
End
Begin VB.CommandButton Command1
Caption = "确认"
Height = 375
Left = 4920
TabIndex = 2
Top = 240
Width = 1095
End
Begin MSComctlLib.TreeView TreeView1
Height = 2985
Left = 120
TabIndex = 1
Top = 420
Width = 4575
_ExtentX = 8070
_ExtentY = 5265
_Version = 393217
LabelEdit = 1
LineStyle = 1
Style = 7
FullRowSelect = -1 'True
SingleSel = -1 'True
Appearance = 1
End
Begin DevPowerTransImg.TransImg TransImg1
Height = 495
Left = 5520
TabIndex = 0
Top = -120
Width = 1095
_ExtentX = 1931
_ExtentY = 873
AutoSize = 0 'False
MaskColor = 16777215
Transparent = -1 'True
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
BorderStyle = 1 'Fixed Single
Caption = "Label1"
Height = 255
Left = 120
TabIndex = 4
Top = 120
Width = 4575
End
End
Attribute VB_Name = "THYJ"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim DATJDGL As Database
Dim THHJAP As Recordset
Dim RECHT As Recordset
Dim RECSK As Recordset
Private Sub Command1_Click()
Dim YSYJ As Currency
On Error GoTo YJERROR
THHJAP.FindFirst ("ID=" & MID(TreeView1.SelectedItem.Key, 2))
If Me.Caption = "收取钥匙押金" Then
If THHJAP("押金") > 0 Then
If MsgBox(TreeView1.SelectedItem.Text + Chr(13) + "请确认是否追加收取?", vbQuestion + vbYesNo, "提示信息") = vbNo Then
TreeView1.SetFocus
Exit Sub
End If
End If
YSYJ = 0
While YSYJ = 0
YSYJ1 = InputBox("请输入收取钥匙押金金额:", "提示窗口", 100)
If YSYJ1 = "" Then
TreeView1.SetFocus
Exit Sub
End If
YSYJ = CCur(YSYJ1)
If YSYJ < 0 Then
MsgBox "收退款不能为负数!", vbCritical, "错误信息"
YSYJ = 0
End If
Wend
THHJAP.Edit
THHJAP("押金") = IIf(IsNull(THHJAP("押金")), 0, THHJAP("押金")) + YSYJ
TreeView1.SelectedItem.Text = IIf(IsNull(THHJAP("姓名")), "无名氏", THHJAP("姓名")) + " 房号:" + IIf(IsNull(THHJAP("房号")), "", CStr(THHJAP("房号"))) + " 押金:" + IIf(IsNull(THHJAP("押金")), "", CStr(THHJAP("押金")) + "元")
THHJAP.Update
THHJAP.FindFirst ("ID=" & MID(TreeView1.SelectedItem.Key, 2))
If MsgBox("请确认是否打印收取钥匙押金收据?", vbYesNo + vbQuestion, "提示信息") = vbYes Then
Load SBZJPREVIEW
SBZJPREVIEW.Caption = "收取钥匙押金"
SBZJPREVIEW.Label2 = IIf(IsNull(THHJAP("姓名")), "无名氏", THHJAP("姓名"))
SBZJPREVIEW.Label3 = "钥匙押金:"
SBZJPREVIEW.Label4 = FormatCurrency(YSYJ) + "元。"
SBZJPREVIEW.Label5 = "人民币" + SUMDM(CDbl(YSYJ)) + "。"
SBZJPREVIEW.Show vbModal
End If
Else
If THHJAP("押金") <= 0 Then
MsgBox TreeView1.SelectedItem.Text + Chr(13) + "未交钥匙押金,不能退款!", vbCritical, "错误信息"
Exit Sub
End If
If MsgBox(TreeView1.SelectedItem.Text + Chr(13) + "请确认是否退还钥匙押金?", vbYesNo + vbQuestion, "提示信息") = vbYes Then
If MsgBox("是否打印退还钥匙押金收据?", vbYesNo + vbQuestion, "提示信息") = vbYes Then
Load TBZJPREVIEW
TBZJPREVIEW.Caption = "退还钥匙押金"
TBZJPREVIEW.Label2 = "退还钥匙押金:"
TBZJPREVIEW.Label3 = FormatCurrency(THHJAP("押金")) + "元。"
TBZJPREVIEW.Label4 = "人民币" + SUMDM(THHJAP("押金")) + "。"
TBZJPREVIEW.Label5 = IIf(IsNull(THHJAP("姓名")), "无名氏", THHJAP("姓名")) + "(签字)"
TBZJPREVIEW.Show vbModal
End If
THHJAP.Edit
THHJAP("押金") = 0
TreeView1.SelectedItem.Text = IIf(IsNull(THHJAP("姓名")), "无名氏", THHJAP("姓名")) + " 房号:" + IIf(IsNull(THHJAP("房号")), "", CStr(THHJAP("房号"))) + " 押金:" + IIf(IsNull(THHJAP("押金")), "", CStr(THHJAP("押金")) + "元")
THHJAP.Update
End If
End If
TreeView1.SetFocus
Exit Sub
YJERROR:
MsgBox CStr(Err.Number) & "-" & Err.Description, vbCritical, "错误信息"
Resume Next
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command3_Click()
Dim INTFH As Integer
Dim STRFH As String
STRFH = InputBox("请输入换入的房间房号:", "换房提示")
If Not IsNumeric(STRFH) Then
MsgBox "输入的数据类型错误!", vbCritical, "错误信息"
TreeView1.SetFocus
Exit Sub
Else
INTFH = CInt(STRFH)
If INTFH = THHJAP("房号") Then
TreeView1.SetFocus
Exit Sub
End If
Set RECHT = DATJDGL.OpenRecordset("房间状态", dbOpenDynaset)
RECHT.FindFirst ("房号=" & INTFH)
If RECHT.NoMatch Then
MsgBox "经查无此房号房间!", vbCritical, "错误信息"
TreeView1.SetFocus
Exit Sub
Else
If RECHT("房态") = "空房" Then
RECHT.Edit
RECHT("房态") = "在住"
RECHT.Update
Else
If RECHT("房态") = "在住" Then
If MsgBox("此房间已有客人入住!是否加客?", vbYesNo + vbQuestion, "提示信息") = vbNo Then
TreeView1.SetFocus
Exit Sub
End If
Else
If RECHT("房态") = "维修" Then
MsgBox "此房间正在维修!", vbCritical, "提示信息"
TreeView1.SetFocus
Exit Sub
Else
If RECHT("房态") = "走房" Then
MsgBox "此房间客人刚走,还未清扫!", vbCritical, "提示信息"
TreeView1.SetFocus
Exit Sub
End If
End If
End If
End If
'检查原房间如无在住客,改房态为走房
INTID = THHJAP("ID")
INTYFH = THHJAP("房号")
MYMARK = THHJAP.Bookmark
THHJAP.FindFirst ("房号=" & INTYFH & " AND ID<>" & INTID)
If THHJAP.NoMatch Then
Set RECSK = DATJDGL.OpenRecordset("散客登记表", dbOpenDynaset)
RECSK.FindFirst ("房号=" & INTYFH)
If RECSK.NoMatch Then
RECHT.FindFirst ("房号=" & INTYFH)
If Not RECHT.NoMatch Then
RECHT.Edit
RECHT("房态") = "走房"
RECHT.Update
End If
End If
End If
THHJAP.Bookmark = MYMARK
'修改客人房号
THHJAP.Edit
THHJAP("房号") = INTFH
TreeView1.SelectedItem.Text = IIf(IsNull(THHJAP("姓名")), "无名氏", THHJAP("姓名")) + " 房号:" + IIf(IsNull(THHJAP("房号")), "", CStr(THHJAP("房号"))) + " 押金:" + IIf(IsNull(THHJAP("押金")), "", CStr(THHJAP("押金")) + "元")
MsgBox "已将" & THHJAP("姓名") & "从" & CStr(INTYFH) & "号房换至" & INTFH & "号房!", vbInformation, "提示信息"
THHJAP.Update
TreeView1.SetFocus
End If
End If
End Sub
Private Sub Command4_Click()
If THHJAP("押金") <> 0 Then
MsgBox "请先办理退还钥匙押金手续!", vbCritical, "提示信息"
TreeView1.SetFocus
Exit Sub
End If
If MsgBox(TreeView1.SelectedItem.Text + Chr(13) + "请确认是否提前离店?", vbQuestion + vbYesNo, "提示信息") = vbYes Then
THHJAP.Delete
Form_Activate
End If
End Sub
Private Sub Form_Activate()
Dim TEMPNODE As Node
STRSQL = " SELECT 团会房间安排.ID, 团会房间安排.团会ID, 团会房间安排.房号, 团会房间安排.姓名, 团会房间安排.性别, 团会房间安排.押金, 团会房间安排.附注 From 团会房间安排 WHERE (((团会房间安排.团会ID)='" & left(Label1.Caption, 12) & "'))"
Set THHJAP = DATJDGL.OpenRecordset(STRSQL, dbOpenDynaset)
If THHJAP.RecordCount = 0 Then
MsgBox "未给团会成员安排房间,不能收取钥匙押金!", vbCritical, "提示信息"
Unload Me
Exit Sub
End If
TreeView1.Nodes.Clear
While Not THHJAP.EOF
If IsNull(THHJAP("姓名")) Then
STRTEXT = "无名氏"
Else
STRTEXT = THHJAP("姓名")
End If
If Not IsNull(THHJAP("房号")) Then STRTEXT = STRTEXT + " 房号:" + CStr(THHJAP("房号"))
If Not IsNull(THHJAP("押金")) Then STRTEXT = STRTEXT + " 押金:" + CStr(THHJAP("押金"))
Set TEMPNODE = TreeView1.Nodes.Add(, , "A" & CStr(THHJAP("ID")), STRTEXT)
THHJAP.MoveNext
Wend
THHJAP.MoveFirst
Set TEMPNODE = TreeView1.Nodes("A" & CStr(THHJAP("ID")))
TEMPNODE.EnsureVisible
TEMPNODE.Selected = True
TreeView1.SetFocus
End Sub
Private Sub Form_Load()
Set DATJDGL = OpenDatabase(App.Path & "\DATA\JDGL.MDB")
End Sub
Private Sub Form_Unload(Cancel As Integer)
DATJDGL.Close
End Sub
Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
THHJAP.FindFirst ("ID=" & MID(TreeView1.SelectedItem.Key, 2))
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -