📄 hy_zymx.frm
字号:
Option Explicit
Dim key_index As Integer
Dim t_bt As String
Dim t_bt1 As String
Dim t_fields As Variant
Dim t_fields1 As Variant
Dim pub_no As Integer
Dim pass As String
Dim t_lock_no As Integer
Dim response As String
Dim response1 As String
Dim t_rec3 As Recordset 'ADDNEW,EDIT,DELETE
Dim t_rec4 As Recordset 'LOCK_NO
Dim t_rec As Recordset 'MSFLEXGRID
Dim rec As Recordset
Dim n As Integer
Dim m As Integer
Dim i As Integer
Dim j As Integer
Dim t_rq As String
Dim hz_mx As String '汇总_明细显示
Private Sub Form_Load()
CENTER Me
Label1.Caption = "会议订单" + yx_hyyd.hy_dh + "租用明细"
Dim sys_uid As String, sys_pwd As String
JZ_USER = SYS_USER + Space(1) + SYS_NAME
JZ_JRSJ2 = Time()
Set t_rec = YX_data.OpenRecordset("select HY_DDH,ZYDM,ZYMC,QSRQ,JZRQ,ZYDW,DJ,ZYSL,HJJE,LSH,LOCK_NO from HY_YDMX where HY_DDH='" & yx_hyyd.hy_dh & " '", 4)
If Not t_rec.BOF Then
t_rec.MoveLast
End If
Set rec = YX_data.OpenRecordset("select ZYDM,ZYMC from HY_ZYK ", 4)
If Not rec.BOF Then
rec.MoveLast
rec.MoveFirst
Dim i As Integer
i = 0
Do While Not rec.EOF
m_zymc.AddItem Trim(rec.Fields("ZYMC")), i
rec.MoveNext
i = i + 1
Loop
End If
KeyPreview = True
tab_nam.Caption = "租用明细一览表"
t_fields = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
t_bt = "^ 租用资源代码 |^ 租用资源名称 |^ 起用日期 |^ 终止日期 |^ 计量单位 |^单价 |^ 数量 |^ 金额 |^ 流水号"
Call pub_memo.Flex_full(flex1, t_bt, t_rec, t_fields, 8, Array(0, 0, 0, 0, 0, 0, 0, 0, 0))
rec_no.Caption = "当前记录数:" + CStr(flex1.Rows - 1)
Call first
hz_mx = ""
End Sub
Private Sub FLEX2_GotFocus()
On Error GoTo error1
m_zydm.Text = Trim(FLEX2.TextArray(FLEX2.Row * 5))
m_zymc.Text = Trim(FLEX2.TextArray(FLEX2.Row * 5 + 1))
m_zydw1.Text = Trim(FLEX2.TextArray(FLEX2.Row * 5 + 2))
m_zysl1.Text = Trim(FLEX2.TextArray(FLEX2.Row * 5 + 3))
m_hjje1.Text = Trim(FLEX2.TextArray(FLEX2.Row * 5 + 4))
Exit Sub
error1:
If Err() = 383 Then
Resume Next
End If
End Sub
Private Sub FLEX2_RowColChange()
On Error GoTo error1
m_zydm.Text = Trim(FLEX2.TextArray(FLEX2.Row * 5))
m_zymc.Text = Trim(FLEX2.TextArray(FLEX2.Row * 5 + 1))
m_zydw1.Text = Trim(FLEX2.TextArray(FLEX2.Row * 5 + 2))
m_zysl1.Text = Trim(FLEX2.TextArray(FLEX2.Row * 5 + 3))
m_hjje1.Text = Trim(FLEX2.TextArray(FLEX2.Row * 5 + 4))
Exit Sub
error1:
If Err() = 383 Then
Resume Next
End If
End Sub
'确认_返回
Private Sub CMD1_Click(Index As Integer)
Select Case Index
Case 0
If pass = "0" Then '建立
Set t_rec = YX_data.OpenRecordset("select HY_DDH,ZYDM,ZYMC,QSRQ,JZRQ,ZYDW,DJ,ZYSL,HJJE,LSH,LOCK_NO from HY_YDMX where HY_DDH='" & yx_hyyd.hy_dh & " '", 2, 0, 2)
If Not t_rec.BOF Then
t_rec.MoveLast
End If
t_rec.AddNew
t_rec!lock_no = 0
t_rec!HY_DDH = yx_hyyd.hy_dh
t_rec!ZYDM = UCase(Trim(m_zydm.Text))
t_rec!ZYMC = UCase(Trim(m_zymc.Text))
If Not m_qsrq.Text = " - - " Then
t_rec!QSRQ = CDate(Trim(m_qsrq.Text))
End If
If Not m_jzrq.Text = " - - " Then
t_rec!JZRQ = CDate(Trim(m_jzrq.Text))
End If
t_rec!ZYDW = UCase(Trim(m_zydw.Text))
t_rec!DJ = CDec(Trim(m_dj.Text))
t_rec!ZYSL = CDec(Trim(m_zysl.Text))
t_rec!HJJE = CDec(Trim(m_hjje.Text))
'加流水号
Dim j As Integer
Dim T_LSH As String
For j = 1 To 999
Set rec = YX_data.OpenRecordset("select HY_DDH,LSH from HY_YDMX where HY_DDH='" & yx_hyyd.hy_dh & "'AND CSTR(LSH)='" & j & "'", 4)
If Not rec.BOF Then
rec.MoveLast
Else: Exit For
End If
Next
t_rec!lsh = j
t_rec.Update
frm_msg.Caption = "物品租用成功建立!"
Call flex_ref
Call first
Else
If pass = "1" Then '删除
Set t_rec = YX_data.OpenRecordset("select HY_DDH,ZYDM,ZYMC,QSRQ,JZRQ,ZYDW,DJ,ZYSL,HJJE,LSH,LOCK_NO from HY_YDMX where Trim(HY_DDH)='" & yx_hyyd.hy_dh & " 'AND CSTR(LSH)='" & UCase(Trim(m_lsh.Text)) & "'", 2, 0, 2)
If Not t_rec.BOF Then
t_rec.MoveLast
Set rec = YX_data.OpenRecordset("SELECT HY_DDH,LOCK_NO FROM HY_YDDK WHERE HY_DDH='" & yx_hyyd.hy_dh & "'", 2, 0, 2)
If Not rec.BOF Then
rec.MoveLast
'加锁
Do
Select Case Pub_lock("YX", "HY_YDDK", rec) '判断加锁结果
Case "1" '锁订
Exit Do
Case "2" '
Call Pub_UNlock("HY_YDDK", rec)
Exit Sub
End Select
Loop
t_rec.Delete
Call Pub_UNlock("HY_YDDK", rec)
End If
frm_msg.Caption = "物品租用成功删除!"
Call flex_ref
Call first
Else
MsgBox "此记录已不存在", 16
Call flex_ref
Call first
End If
End If
End If
'返回
Case 1
Call first
End Select
End Sub
'增加删除汇总
Private Sub Cmd2_Click(Index As Integer)
Select Case Index
Case 0 '建立
pass = "0"
Call zy_jl
Case 1 '删除
pass = "1"
Call zy_sc
Case 2 '汇总
If Trim(Cmd2(2).Caption) = "汇总(F7)" Then
Call hz
hz_mx = "0"
Set t_rec = YX_data.OpenRecordset("select HY_DDH,ZYDM,ZYMC,QSRQ,JZRQ,ZYDW,DJ,ZYSL,HJJE,LSH,LOCK_NO from HY_YDMX where HY_DDH='" & yx_hyyd.hy_dh & " '", 4)
If Not t_rec.BOF Then
t_rec.MoveLast
m = t_rec.RecordCount
t_rec.MoveFirst
Set t_rec3 = YX_data.OpenRecordset("select HY_DDH,ZYDM,ZYMC,ZYDW,ZYSL,HJJE,LOCK_NO from HY_ZYMX_HZ ", 2, 0, 2)
If Not t_rec3.BOF Then
t_rec3.MoveLast
n = t_rec3.RecordCount
t_rec3.MoveFirst
End If
If Not t_rec3.EOF Then
For i = 1 To n
t_rec3.Delete
t_rec3.MoveNext
Next i
End If
If Not t_rec.EOF Then
For j = 1 To m
Set t_rec4 = YX_data.OpenRecordset("select HY_DDH,ZYDM,ZYMC,ZYDW,ZYSL,HJJE,LOCK_NO from HY_ZYMX_HZ WHERE TRIM(HY_DDH)='" & yx_hyyd.hy_dh & "' AND TRIM(ZYDM)='" & Trim(t_rec!ZYDM) & "'", 4)
If t_rec4.BOF Then
t_rec3.AddNew
t_rec3!HY_DDH = yx_hyyd.hy_dh
t_rec3!ZYDM = Trim(t_rec!ZYDM)
t_rec3!ZYMC = Trim(t_rec!ZYMC)
t_rec3!ZYDW = Trim(t_rec!ZYDW)
t_rec3!ZYSL = Trim(t_rec!ZYSL)
t_rec3!HJJE = Trim(t_rec!HJJE)
Else
t_rec4.MoveLast
t_rec4.MoveFirst
t_rec3.MoveLast
t_rec3.Edit
t_rec3!HY_DDH = yx_hyyd.hy_dh
t_rec3!ZYDM = Trim(t_rec3!ZYDM)
t_rec3!ZYMC = Trim(t_rec3!ZYMC)
t_rec3!ZYDW = Trim(t_rec!ZYDW)
t_rec3!ZYSL = CDec(CDec(Trim(t_rec3!ZYSL)) + CDec(Trim(t_rec!ZYSL)))
t_rec3!HJJE = CDec(CDec(Trim(t_rec3!HJJE)) + CDec(Trim(t_rec!HJJE)))
End If
t_rec3.Update
t_rec.MoveNext
Next j
End If
tab_nam.Caption = "租用明细汇总表"
Cmd2(2).Caption = "显示明细(F7)"
Cmd2(0).Enabled = False
Cmd2(1).Enabled = False
Cmd2(3).Enabled = False
Call flex_ref
Call ret
'租用明细中无会议单号对应记录
Else
frm_msg.Caption = "无可汇总记录."
Call first
End If
Else '显示明细
If Trim(Cmd2(2).Caption) = "显示明细(F7)" Then
Call xsmx
hz_mx = ""
Cmd2(2).Caption = "汇总(F7)"
tab_nam.Caption = "租用明细一览表"
Call flex_ref
Call first
End If
End If
Case 3 '刷新
Call flex_ref
Call first
End Select
End Sub
Private Sub flex1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
Cmd2(0).SetFocus
End If
End Sub
Private Sub Cmd3_Click()
Unload Me
yx_hyyd.Show (1)
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
key_index = 100
If hz_mx <> "0" Then
Select Case KeyCode
Case vbKeyF2
key_index = 0 '建立
Case vbKeyF4
key_index = 1 '解除
Case vbKeyF7
key_index = 2 '汇总
Case vbKeyF9
key_index = 3 '刷新
Case vbKeyEscape
key_index = 99 '退出
End Select
Else
Select Case KeyCode
Case vbKeyF7
key_index = 2 '汇总
Case vbKeyF9
key_index = 3 '刷新
Case vbKeyEscape
key_index = 99 '退出
End Select
End If
If key_index = 99 Then
If Frame2.Enabled = False Then
Call Cmd3_Click
Else
Call first
End If
Else
Call Cmd2_Click(key_index)
End If
End Sub
Private Sub m_dj_Change()
frm_msg.Caption = ""
End Sub
Private Sub m_jzrq_Change()
frm_msg.Caption = ""
End Sub
Private Sub m_jzrq_GotFocus()
m_jzrq.SelStart = 0
m_jzrq.SelLength = Len(m_jzrq.Text)
End Sub
Private Sub m_jzrq_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
If Not m_jzrq.Text = " - - " Then
t_rq = date_cl(Trim(m_jzrq.Text))
If t_rq <> "F" Then
m_jzrq = t_rq
End If
Call m_jzrq_LostFocus
Else
m_zysl.SetFocus
m_zysl.SelStart = 0
m_zysl.SelLength = Len(Trim(m_zysl.Text))
End If
End If
End Sub
Private Sub m_jzrq_LostFocus()
If Frame2.Enabled = True Then
If Not m_jzrq.Text = " - - " Then
If IsDate(m_jzrq.Text) Then
If CDate(Trim(m_jzrq.Text)) >= CDate(Trim(m_qsrq.Text)) Then
m_zysl.SetFocus
m_zysl.SelStart = 0
m_zysl.SelLength = Len(Trim(m_zysl.Text))
Else
frm_msg.Visible = True
frm_msg.Caption = "无效终止日期!!"
m_jzrq.SetFocus
m_jzrq.SelStart = 0
m_jzrq.SelLength = Len(m_jzrq.Text)
End If
Else
frm_msg.Visible = True
frm_msg.Caption = "无效终止日期!!"
m_jzrq.SetFocus
m_jzrq.SelStart = 0
m_jzrq.SelLength = Len(m_jzrq.Text)
End If
End If
End If
End Sub
Private Sub m_qsrq_Change()
frm_msg.Caption = ""
End Sub
Private Sub m_qsrq_GotFocus()
m_qsrq.SelStart = 0
m_qsrq.SelLength = Len(m_qsrq.Text)
End Sub
Private Sub m_qsrq_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
If Not m_qsrq.Text = " - - " Then
t_rq = date_cl(Trim(m_qsrq.Text))
If t_rq <> "F" Then
m_qsrq = t_rq
End If
Call m_qsrq_LostFocus
Else
m_jzrq.SetFocus
End If
End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -