📄 cx_zdkr.frm
字号:
Else
cx_zdkr_mx.m_rzrq.Text = Format(Trim(rec!rzrq), "yyyy-mm-dd")
End If
If IsNull(rec!rzsj) Then
cx_zdkr_mx.m_rzsj.Text = " - - "
Else
cx_zdkr_mx.m_rzsj.Text = Format(Trim(rec!rzsj), "hh:mm:ss")
End If
If IsNull(rec!ldrq) Then
cx_zdkr_mx.m_ldrq.Text = " - - "
Else
cx_zdkr_mx.m_ldrq.Text = Format(Trim(rec!ldrq), "yyyy-mm-dd")
End If
If IsNull(rec!ldsj) Then
cx_zdkr_mx.m_ldsj.Text = " - - "
Else
cx_zdkr_mx.m_ldsj.Text = Format(Trim(rec!ldsj), "hh:mm:ss")
End If
cx_zdkr_mx.m_vip_dj.Text = Trim(NULL_FT(rec!vip_dj))
cx_zdkr_mx.m_fkfs.Text = Trim(NULL_FT(rec!dj_fkmc))
If Trim(NULL_FT(rec!qd_ft)) = "1" Then
cx_zdkr_mx.op_qd_ft(1).Value = True
Else
cx_zdkr_mx.op_qd_ft(0).Value = True
End If
If Trim(NULL_FT(rec!mfzc_ft)) = "1" Then
cx_zdkr_mx.op_mfzc_ft(1).Value = True
Else
cx_zdkr_mx.op_mfzc_ft(0).Value = True
End If
cx_zdkr_mx.m_zklx.Text = Trim(NULL_FT(rec!zklx_mc))
cx_zdkr_mx.m_kf_zkl.Text = Trim(NULL_FT(rec!kf_zkl))
cx_zdkr_mx.m_kf_fz.Text = Trim(NULL_FT(rec!kf_fz))
cx_zdkr_mx.m_kf_fwf.Text = Trim(NULL_FT(rec!kf_fwf))
cx_zdkr_mx.m_jd_bz1.Text = Trim(NULL_FT(rec!jd_bz1))
cx_zdkr_mx.m_tsfw.Text = Trim(NULL_FT(rec!tsfw))
cx_zdkr_mx.m_jdy.Text = Trim(NULL_FT(rec!jdy))
cx_zdkr_mx.m_td_zh.Text = Trim(NULL_FT(rec!td_zh))
cx_zdkr_mx.m_td_mc.Text = Trim(NULL_FT(rec!tdmc))
cx_zdkr_mx.m_bdjddw_mc.Text = Trim(NULL_FT(rec!ywdw_mc))
cx_zdkr_mx.m_dfy_dm.Text = Trim(NULL_FT(rec!dfy_dm))
cx_zdkr_mx.m_czy.Text = Trim(NULL_FT(rec!CZY))
Call cx_zdkr_mx.MAIN(Label1.Caption)
cx_zdkr_mx.Show (1)
End If
Case 1 '筛选
Frame2.Enabled = True
Cmd2(0).Enabled = False
Cmd2(1).Enabled = False
Cmd2(2).Enabled = False
Cmd2(3).Enabled = False
Cmd2(4).Enabled = False
Cmd2(5).Enabled = False
m_zh.SetFocus
Case 2 '今日预离
TJ = "cstr(LDRQ)='" & Date & "'"
Set rec = PUB_data.OpenRecordset("select ZH,trim(KR_X)+trim(KR_M),trim(YW_X)+trim(YW_M),KR_XBMC,GJMC,RZRQ,LDRQ from DT_KRQD Where " & TJ & " order by zh ", 2, 0, 2)
If Not rec.BOF Then
rec.MoveLast
rec.MoveFirst
frm_msg.Visible = True
frm_msg.Caption = "今日预离店客人显示!"
Call Flex_full(flex1, t_bt, rec, t_fields, 6, Array(0, 0, 0, 0, 0, 0, 0))
rec_num.Caption = "记录数:" + CStr(flex1.Rows - 1)
Else
MsgBox "无今日离店客人!"
Exit Sub
End If
Case 3 '明日预离
TJ = "cstr(LDRQ)='" & Date + 1 & "'"
Set rec = PUB_data.OpenRecordset("select ZH,trim(KR_X)+trim(KR_M),trim(YW_X)+trim(YW_M),KR_XBMC,GJMC,RZRQ,LDRQ from DT_KRQD Where " & TJ & " order by zh", 2, 0, 2)
If Not rec.BOF Then
rec.MoveLast
rec.MoveFirst
frm_msg.Visible = True
frm_msg.Caption = "明日预离店客人显示!"
Call Flex_full(flex1, t_bt, rec, t_fields, 6, Array(0, 0, 0, 0, 0, 0, 0))
rec_num.Caption = "记录数:" + CStr(flex1.Rows - 1)
Else
MsgBox "无明日离店客人!"
Exit Sub
End If
Case 4 '打印
If TJ = "" Then
Set rec = PUB_data.OpenRecordset("SELECT ZH,KR_X,KR_M,GJMC,RZRQ,LDRQ,ZJMC,KR_ZJHM,KR_DJ,ZXFE,YE FROM DT_KRQD Order by ZH", 4)
If Not rec.BOF Then
rec.MoveLast
Call print_tabler(rec, "在店客人帐首打印", Array("帐号", "客人姓", "客人名", "客人国籍", "入住日期", "预离日期", "证件类型", "证件号码", "定金", "总消费额", "余额"), Array(7, 15, 15, 10, 12, 12, 12, 10, 6, 10, 10), 0, Array(11, 11, 11, 11, 11, 11, 11, 11, 21, 21, 21))
Else
MsgBox "无可打印帐首信息!", 64
End If
Else
Set rec = PUB_data.OpenRecordset("SELECT ZH,KR_X,KR_M,GJMC,RZRQ,LDRQ,ZJMC,KR_ZJHM,KR_DJ,ZXFE,YE FROM DT_KRQD Where " & TJ & " Order BY ZH", 4)
If Not rec.BOF Then
rec.MoveLast
Call print_tabler(rec, "在店客人帐首打印", Array("帐号", "客人姓", "客人名", "客人国籍", "入住日期", "预离日期", "证件类型", "证件号码", "定金", "总消费额", "余额"), Array(7, 15, 15, 10, 12, 12, 12, 10, 6, 10, 10), 0, Array(11, 11, 11, 11, 11, 11, 11, 11, 21, 21, 21))
Else
MsgBox "无可打印帐首信息!", 64
End If
End If
Case 5
Call flex1_ref
End Select
End Sub
Function pub_zklb(t_td_zh As String, zklb_rqq As Date, pub_code As String)
Dim zklb_rq As Integer
Dim zklb_rq1 As Date
Dim zklb_rq2 As Date
Dim n As Integer
zklb_rq = pub_mday(Date, pub_code)
zklb_rq1 = Date - day(Date) + 1
zklb_rq2 = Date - day(Date) + zklb_rq
Select Case pub_code
Case Is <= "B0650"
Label2.Caption = " 在店客人列表"
If pub_code = "B0640" Then
Cmd2(0).Enabled = True
Cmd2(1).Enabled = True
Cmd2(2).Enabled = True
Cmd2(3).Enabled = True
Cmd2(4).Enabled = True
End If
Set rec = PUB_data.OpenRecordset("select ZH,trim(KR_X)+trim(KR_M),trim(YW_X)+trim(YW_M),KR_XBMC,GJMC,RZRQ,LDRQ from DT_KRQD order by zh", 2, 0, 2)
If Not rec.BOF Then
rec.MoveLast
n = rec.RecordCount
rec.MoveFirst
End If
If n = 0 Then
MsgBox "没有可供查询的数据!"
Cmd2(0).Enabled = False
Cmd2(1).Enabled = False
Cmd2(2).Enabled = False
Cmd2(3).Enabled = False
Cmd2(4).Enabled = False
Cmd2(5).Enabled = False
Exit Function
End If
t_bt = "^房号 |^中文姓名 |^英文姓名 |^性别 |^国籍 |^来店日期 |^离店日期 "
t_fields = Array(0, 1, 2, 3, 4, 5, 6)
Call Flex_full(flex1, t_bt, rec, t_fields, 6, Array(0, 0, 0, 0, 0, 0, 0))
rec_num.Caption = "记录数:" + CStr(flex1.Rows - 1)
Case Else
MsgBox " 无法识别的功能调用!"
Exit Function
End Select
End Function
Private Sub m_zh_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Or KeyCode = vbKeyDown Then
m_kr_lx.SetFocus
End If
End Sub
Private Sub m_kr_lx_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Or KeyCode = vbKeyDown Then
m_rzrq.SetFocus
Else
If KeyCode = vbKeyUp Then
m_zh.SetFocus
End If
End If
End Sub
Private Sub m_rzrq_KeyDown(KeyCode As Integer, Shift As Integer)
Dim t_rq As String
If KeyCode = vbKeyReturn Or KeyCode = vbKeyDown Then
If m_rzrq.Text <> " - - " Then
t_rq = date_cl(m_rzrq.Text)
If t_rq <> "F" Then
m_rzrq = t_rq
m_rzrq.BackColor = RGB(255, 255, 255)
m_ldrq.SetFocus
Else
m_rzrq.BackColor = RGB(255, 0, 0)
frm_msg.Visible = True
frm_msg.Caption = " 日期输入错误!"
m_rzrq.SetFocus
End If
Else
m_rzrq.BackColor = RGB(255, 255, 255)
m_ldrq.SetFocus
End If
Else
If KeyCode = vbKeyUp Then
m_kr_lx.SetFocus
End If
End If
End Sub
Private Sub m_ldrq_KeyDown(KeyCode As Integer, Shift As Integer)
Dim t_rq As String
If KeyCode = vbKeyReturn Or KeyCode = vbKeyDown Then
If m_ldrq.Text <> " - - " Then
t_rq = date_cl(m_ldrq.Text)
If t_rq <> "F" Then
m_ldrq.Text = t_rq
m_ldrq.BackColor = RGB(255, 255, 255)
m_kr_x.SetFocus
Else
m_ldrq.BackColor = RGB(255, 0, 0)
frm_msg.Visible = True
frm_msg.Caption = " 日期输入错误!"
m_ldrq.SetFocus
End If
Else
m_ldrq.BackColor = RGB(255, 255, 255)
m_kr_x.SetFocus
End If
Else
If KeyCode = vbKeyUp Then
m_rzrq.SetFocus
End If
End If
End Sub
Private Sub m_kr_x_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Or KeyCode = vbKeyDown Then
m_gjdm.SetFocus
Else
If KeyCode = vbKeyUp Then
m_ldrq.SetFocus
End If
End If
End Sub
Private Sub m_gjdm_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Or KeyCode = vbKeyDown Then
m_yw_x.SetFocus
Else
If KeyCode = vbKeyUp Then
m_kr_x.SetFocus
End If
End If
End Sub
Private Sub m_yw_x_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Or KeyCode = vbKeyDown Then
m_yw_m.SetFocus
Else
If KeyCode = vbKeyUp Then
m_gjdm.SetFocus
End If
End If
End Sub
Private Sub m_yw_m_KeyDown(KeyCode As Integer, Shift As Integer)
Dim t_rq As String
Dim t_rq2 As String
If KeyCode = vbKeyReturn Or KeyCode = vbKeyDown Then
If Trim(m_zh.Text) = "" Then
TJ = ""
Else
TJ = "LEFT(TRIM(ZH),4)='" & Trim(m_zh.Text) & "'"
End If
If Trim(m_kr_lx.Text) <> "" Then
If TJ = "" Then
TJ = TJ & "CSTR(TRIM(ZKLX))='" & CStr(Trim(m_kr_lx.Text)) & "'"
Else
TJ = TJ & " AND CSTR(TRIM(ZKLX))='" & CStr(Trim(m_kr_lx.Text)) & "'"
End If
End If
If Trim(m_rzrq.Text) <> " - - " Then
t_rq = date_cl(m_rzrq.Text)
If t_rq <> "F" Then
m_rzrq.Text = t_rq
End If
If IsDate(Trim(m_rzrq.Text)) Then
If TJ = "" Then
TJ = TJ & "CSTR(RZRQ)='" & CDate(Trim(m_rzrq)) & "'"
Else
TJ = TJ & " AND CSTR(RZRQ)='" & CDate(Trim(m_rzrq)) & "'"
End If
Else
m_rzrq.SetFocus
m_rzrq.SelStart = 0
m_rzrq.SelLength = Len(Trim(m_rzrq.Text))
End If
End If
If Trim(m_ldrq.Text) <> " - - " Then
t_rq2 = date_cl(m_ldrq.Text)
If t_rq2 <> "F" Then
m_ldrq.Text = t_rq2
End If
If IsDate(m_ldrq.Text) Then
If TJ = "" Then
TJ = TJ & "CSTR(LDRQ)='" & CDate(Trim(m_ldrq)) & "'"
Else
TJ = TJ & " AND CSTR(LDRQ)='" & CDate(Trim(m_ldrq)) & "'"
End If
Else
m_ldrq.SetFocus
m_ldrq.SelStart = 0
m_ldrq.SelLength = Len(Trim(m_ldrq.Text))
End If
End If
If Trim(m_kr_x.Text) <> "" Then
If TJ = "" Then
TJ = TJ & "TRIM(KR_X)='" & Trim(m_kr_x.Text) & "'"
Else
TJ = TJ & " AND TRIM(KR_X)='" & Trim(m_kr_x.Text) & "'"
End If
End If
If Trim(m_gjdm.Text) <> "" Then
If TJ = "" Then
TJ = TJ & "TRIM(GJDM)='" & Trim(m_gjdm.Text) & "'"
Else
TJ = TJ & " AND TRIM(GJDM)='" & Trim(m_gjdm.Text) & "'"
End If
End If
If Trim(m_yw_x.Text) <> "" Then
If TJ = "" Then
TJ = TJ & "TRIM(YW_X)='" & Trim(m_yw_x.Text) & "'"
Else
TJ = TJ & " AND TRIM(YW_X)='" & Trim(m_yw_x.Text) & "'"
End If
End If
If Trim(m_yw_m.Text) <> "" Then
If TJ = "" Then
TJ = TJ & "TRIM(YW_M)='" & Trim(m_yw_m.Text) & "'"
Else
TJ = TJ & " AND TRIM(YW_M)='" & Trim(m_yw_m.Text) & "'"
End If
End If
Call flex1_ref
Call first
Else
If KeyCode = vbKeyUp Then
m_yw_x.SetFocus
End If
End If
End Sub
Private Sub XT_Timer_Timer()
JZ_DQSJ2.Caption = Time()
End Sub
Private Sub flex1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Or KeyCode = vbKeyDown Then
Cmd2(0).SetFocus
End If
End Sub
Function NULL_FT(T_VARX As Variant) As Variant
If IsNull(T_VARX) Then
NULL_FT = Space(1)
Else
NULL_FT = T_VARX
End If
End Function
Private Sub flex1_ref()
If TJ = "" Then
Set rec = PUB_data.OpenRecordset("select ZH,trim(KR_X)+trim(KR_M),trim(YW_X)+trim(YW_M),KR_XBMC,GJMC,RZRQ,LDRQ from DT_KRQD order by zh", 2, 0, 2)
If Not rec.BOF Then
rec.MoveLast
rec.MoveFirst
End If
Else
Set rec = PUB_data.OpenRecordset("select ZH,trim(KR_X)+trim(KR_M),trim(YW_X)+trim(YW_M),KR_XBMC,GJMC,RZRQ,LDRQ from DT_KRQD Where " & TJ & "order by zh", 2, 0, 2)
If Not rec.BOF Then
rec.MoveLast
rec.MoveFirst
End If
End If
Call Flex_full(flex1, t_bt, rec, t_fields, 6, Array(0, 0, 0, 0, 0, 0, 0))
rec_num.Caption = "记录数:" + CStr(flex1.Rows - 1)
End Sub
Private Sub first()
If TJ = "" Then
m_zh.Text = ""
m_kr_lx.Text = ""
m_rzrq.Text = " - - "
m_ldrq.Text = " - - "
m_kr_x.Text = ""
m_gjdm.Text = ""
m_yw_x.Text = ""
m_yw_m.Text = ""
End If
Cmd2(0).Enabled = True
Cmd2(1).Enabled = True
Cmd2(2).Enabled = True
Cmd2(3).Enabled = True
Cmd2(4).Enabled = True
Cmd2(5).Enabled = True
Frame2.Enabled = False
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -