📄 ˪-i㦥
字号:
Call Sub_OperStatus("10")
'调入用户查询结果动态集,并定位该单据
Sqlstr = "SELECT * From Rp_Note a " & Str_QueryCondi & " ORDER BY NoteID"
Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
Rec_Query.Find "NoteID=" & Val(Lab_BillId.Caption)
Case "3" '明细帐联查单据
'设置工具条显示
With Tlb_Action
.Buttons("xz").Enabled = False '新增
.Buttons("xg").Enabled = False '修改
.Buttons("sc").Enabled = False '删除
.Buttons("fgh0").Enabled = False '分隔行
.Buttons("zh").Enabled = False '增行
.Buttons("sh").Enabled = False '删行
.Buttons("fgh1").Enabled = False '分隔行
.Buttons("bc").Enabled = False '保存
.Buttons("fq").Enabled = False '放弃
.Buttons("shsh").Enabled = False '审核
.Buttons("fgh2").Enabled = False '分隔行
.Buttons("fgh5").Enabled = False '分割行
End With
Call Sub_ShowBill
'设置操作状态为浏览
Lab_OperStatus.Caption = "1"
'录入文本框
For jsqte = Max_Text_Index To 0 Step -1
LrText(jsqte).Enabled = False
Next jsqte
End Select
'<<]
End Sub
Private Sub Sub_ShowBill() '根据当前单据ID显示整张单据内容
'过程默认参数为当前窗体中单据ID:Lab_BillID
Dim Sqlstr As String '临时使用字符串
Dim RecTemp As New ADODB.Recordset '临时使用动态集
Dim jsqte As Long '临时计数器
'本张单据查询字符串
Sqlstr = "SELECT * From Ar_v_Note Where NoteID='" & Val(Lab_BillId.Caption) & "'"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With RecTemp
If Not .EOF Then
'[>>显示单据
TextChangeLock = True '文本框加锁
If .Fields("BillItemCode") = "01" Then
OptReceNoteType(0).Value = True
Else
OptReceNoteType(1).Value = True
End If
LrText(0).Text = Trim(.Fields("NoteCode")) '结算单据号
If IsDate(.Fields("BillDate")) Then
LrText(1).Text = Format(.Fields("BillDate"), "yyyy-mm-dd") '收票日期
End If
LrText(2).Tag = Trim(.Fields("PsCode")) '客户编码
LrText(2).Text = Trim(.Fields("CusName") & "") '客户名称
If IsDate(.Fields("SignDate")) Then
LrText(3).Text = Format(.Fields("SignDate"), "yyyy-mm-dd") '签发日期
End If
If IsDate(.Fields("ExpireDate")) Then
LrText(4).Text = Format(.Fields("ExpireDate"), "yyyy-mm-dd") '到期日期
End If
LrText(5).Text = Trim(.Fields("Payer") & "") '付款人
LrText(6).Text = Trim(.Fields("ForeignCurrName") & "") '
LrText(6).Tag = Trim(.Fields("ForeignCurrCode") & "") '
LrText(7).Text = Trim(.Fields("YbSsJe") & "") '
LrText(8).Text = Trim(.Fields("AccRate") & "") '
LrText(9).Text = Trim(.Fields("BbSsJe") & "") '
LrText(10).Text = Trim(.Fields("YbInterest") & "")
LrText(11).Tag = Trim(.Fields("DeptCode") & "") '
LrText(11).Text = Trim(.Fields("DeptName") & "") '
LrText(12).Tag = Trim(.Fields("PersonCode") & "") '
LrText(12).Text = Trim(.Fields("PersonName") & "") '
LrText(13).Text = Trim(.Fields("Digest") & "") '备注
LrText(14).Text = Trim(.Fields("Maker") & "") '制单人
LrText(15).Text = Trim(.Fields("Checker") & "") '审核人
TextChangeLock = False '文本框解锁
Call Sub_GetAccRate(LrText(6).Tag, Bln_ConVertFlag, Dbl_AccRate) '取外币记帐汇率方式
'<<]
End If
End With
'设置审核弃审按钮状态
Call Sub_CheckStatus
Call Sub_CheckNoteStatus
End Sub
Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button) '用户点击工具条
'屏蔽文本框,下拉组合框有效性判断
Valilock = True
'屏蔽网格失去焦点产生的有效性判断
changelock = True
Select Case Button.Key
Case "yl" '预 览
BillTextPrint Lab_Bill, LrText, TextGroupCode, "Ar_Note", False
Case "dy" '打 印
Dim yhAnswer As Integer '打印提示
'用户确认是否打印单据
Tsxx = "请确认是否打印当前单据?"
yhAnswer = Xtxxts(Tsxx, 2, 2)
If yhAnswer = 2 Then
Exit Sub
End If
BillTextPrint Lab_Bill, LrText, TextGroupCode, "Ar_Note", True
Case "xz" '新 增
Call Sub_AddBill
Case "xg" '修 改
Call Sub_EditBill
Case "sc" '删 除
Call Sub_DeleteBill
Case "bc" '保 存
Call Sub_SaveBill
Case "fq" '放 弃
Call Sub_AbandonBill
Case "shsh" '审 核
Call Sub_CheckBill
Case "Discount" '贴现
Call Sub_NoteDiscount
Case "Encash" '兑现
Call Sub_NoteEncash
Case "Endorse" '背书
Call Sub_NoteEndorse
Case "TurnOut" '转出
Call Sub_NoteTurnOut
Case "bz" '帮 助
Call F1bz
Case "fh" '退 出
Unload Me
Case "Voucher" '凭证
Call Voucher
End Select
'解 锁
Valilock = False
changelock = False
TextChangeLock = False
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) '支持热键操作
Select Case KeyCode
Case vbKeyF5 '增加单据
If Tlb_Action.Buttons("xz").Enabled And Tlb_Action.Buttons("xz").Visible Then
Call Sub_AddBill
End If
Case vbKeyF3 '修改单据
If Tlb_Action.Buttons("xg").Enabled And Tlb_Action.Buttons("xg").Visible Then
Call Sub_EditBill
End If
Case vbKeyF6 '保存单据
If Tlb_Action.Buttons("bc").Enabled And Tlb_Action.Buttons("bc").Visible Then
Call Sub_SaveBill
End If
End Select
End Sub
Private Sub Sub_OperStatus(Str_Status As String) '工具条依据不同状态所进行的变化
With Tlb_Action
Select Case Str_Status
Case "10" '浏览((列表)调入单据处理时的进入状态、(列表)新增状态时放弃录入)
'工具条
.Buttons("dy").Enabled = True '打印
.Buttons("yl").Enabled = True '预览
.Buttons("xz").Enabled = True '新增
.Buttons("xg").Enabled = True '修改
.Buttons("sc").Enabled = True '删除
.Buttons("bc").Enabled = False '保存
.Buttons("fq").Enabled = False '放弃
.Buttons("bz").Enabled = True '帮助
.Buttons("fh").Enabled = True '退出
'设置审核弃审按钮状态
Call Sub_CheckStatus
'设置单据处理状态
Call Sub_CheckNoteStatus
'设置文本框录入状态
Call Sub_LrtextStatus(False)
Case "20" '新增单据(（录入）新增一张单据 、（列表）新增一张单据)
'工具条
.Buttons("dy").Enabled = False '打印
.Buttons("yl").Enabled = False '预览
.Buttons("xz").Enabled = False '新增
.Buttons("xg").Enabled = False '修改
.Buttons("sc").Enabled = False '删除
.Buttons("bc").Enabled = True '保存
.Buttons("fq").Enabled = True '放弃
.Buttons("shsh").Enabled = False '审核
.Buttons("Voucher").Enabled = False '凭证
.Buttons("Encash").Enabled = False '兑现
.Buttons("Discount").Enabled = False '贴现
.Buttons("Endorse").Enabled = False '背书
.Buttons("TurnOut").Enabled = False '转出
'设置文本框录入状态
Call Sub_LrtextStatus(True)
Case "30" '修改(（录入）调入修改功能、（列表）调入修改功能)
'工具条
.Buttons("dy").Enabled = False '打印
.Buttons("yl").Enabled = False '预览
.Buttons("xz").Enabled = False '新增
.Buttons("xg").Enabled = False '修改
.Buttons("sc").Enabled = False '删除
.Buttons("bc").Enabled = True '保存
.Buttons("fq").Enabled = True '放弃
.Buttons("shsh").Enabled = False '审核
.Buttons("bz").Enabled = True '帮助
.Buttons("fh").Enabled = True '退出
.Buttons("Voucher").Enabled = False '凭证
.Buttons("Encash").Enabled = False '兑现
.Buttons("Discount").Enabled = False '贴现
.Buttons("Endorse").Enabled = False '背书
.Buttons("TurnOut").Enabled = False '转出
'设置文本框录入状态
Call Sub_LrtextStatus(True)
End Select
End With
End Sub
Private Sub Sub_LrtextStatus(TextEnabled As Boolean) '设置录入文本框状态
'录入文本框状态设置
If TextEnabled Then
For jsqte = Max_Text_Index To 0 Step -1
'判断文本框是否可编辑
If Textboolean(jsqte, 5) Then
LrText(jsqte).Enabled = True
Else
LrText(jsqte).Enabled = False
End If
Next jsqte
'自定义
Frame1.Enabled = True
'自定义
Else
For jsqte = Max_Text_Index To 0 Step -1
LrText(jsqte).Enabled = False
Next jsqte
'自定义
Frame1.Enabled = False
'自定义
End If
End Sub
Private Sub Sub_CheckStatus() '设置审核弃审按钮状态(亦可设置其他动作按钮状态)
'根据当前单据状态来确定审核弃审按钮状态
If Trim(LrText(14).Text) <> "" And Trim(LrText(15).Text) = "" Then '单据未审核
Tlb_Action.Buttons("shsh").Enabled = True '审核
End If
If Trim(LrText(14).Text) <> "" And Trim(LrText(15).Text) <> "" Then '单据已审核
Tlb_Action.Buttons("shsh").Enabled = False '审核
End If
End Sub
Private Sub Sub_AddBill() '新增一张单据
Dim RecTemp As New ADODB.Recordset '临时使用动态集
Dim jsqte As Long '临时计数器
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
If Not Security_Log("Ar_Note_Edit", Xtczybm, 1, True) Then
Exit Sub
End If
'设置操作状态为新增(Fixed)
Lab_OperStatus.Caption = "2"
'设置工具条状态(Fixed)
Call Sub_OperStatus("20")
'清空VouchID(Fixed)
Lab_BillId.Caption = ""
'添
Lab_NoteStatus.Caption = "" '记录票据状态
'录入文本框清除内容
For jsqte = Max_Text_Index To 0 Step -1
LrText(jsqte).Tag = ""
LrText(jsqte).Text = ""
Next jsqte
'[>>显示制单人,清空审核人,此处还可以设置录入默认值如自动生成单据号、默认单据录入日期注意加锁
LrText(14).Text = Xtczy
LrText(15).Text = ""
'设置订单日期默认为系统业务日期
TextChangeLock = True
LrText(1).Text = Xtrq
LrText(6).Text = XtSCurrName '币别名称
LrText(6).Tag = XtSCurrCode '币别编码
Call Sub_GetAccRate(LrText(6).Tag, Bln_ConVertFlag, Dbl_AccRate)
LrText(8).Text = Dbl_AccRate
TextChangeLock = False
'读取最新的单据编码
LrText(0).Text = CreatBillCode(BillCode, False)
'<<]
'让第一个录入项得到焦点(Fixed)
On Error Resume Next
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -