📄
字号:
Case "2" '查询凭证(凭证列表)
Me.Caption = "查询凭证列表"
'设置工具条显示
With Tlb_Action
.Buttons("cx").Visible = False '查询
.Buttons("fgh3").Visible = False '分割行
.Buttons("xz").Visible = False '新增
.Buttons("sc").Visible = False '删除
.Buttons("shsh").Visible = False '审核
.Buttons("shqs").Visible = False '弃审
.Buttons("shbc").Visible = False '标错
.Buttons("qbsh").Visible = False '全审
.Buttons("qbfq").Visible = False '全弃
.Buttons("fgh6").Visible = False '分隔行
.Buttons("fgh7").Visible = False '分隔行
End With
Call Sub_ShowBill
'设置操作状态为浏览
Lab_OperStatus.Caption = "1"
'设置工具条状态
Call Sub_OperStatus("11")
Case "3" '审核凭证
Me.Caption = "审核凭证"
'设置工具条显示
With Tlb_Action
.Buttons("xz").Visible = False '新增
.Buttons("xg").Visible = False '修改
.Buttons("sc").Visible = False '删除
.Buttons("fgh0").Visible = False '分隔行
.Buttons("zh").Visible = False '增行
.Buttons("sh").Visible = False '删行
.Buttons("fgh1").Visible = False '分隔行
.Buttons("bc").Visible = False '保存
.Buttons("fq").Visible = False '放弃
.Buttons("fgh2").Visible = False '分隔行
.Buttons("cx").Visible = False '查询
.Buttons("fgh3").Visible = False '分割行
End With
Call Sub_ShowBill
'设置操作状态为浏览
Lab_OperStatus.Caption = "1"
'设置工具条状态
Call Sub_OperStatus("11")
Case "4" '明细帐联查凭证
Me.Caption = "明细帐联查凭证"
'设置工具条显示
With Tlb_Action
.Buttons("xz").Visible = False '新增
.Buttons("xg").Visible = False '修改
.Buttons("sc").Visible = False '删除
.Buttons("fgh0").Visible = False '分隔行
.Buttons("zh").Visible = False '增行
.Buttons("sh").Visible = False '删行
.Buttons("fgh1").Visible = False '分隔行
.Buttons("bc").Visible = False '保存
.Buttons("fq").Visible = False '放弃
.Buttons("fgh2").Visible = False '分隔行
.Buttons("shsh").Visible = False '审核
.Buttons("shqs").Visible = False '弃审
.Buttons("shbc").Visible = False '标错
.Buttons("qbsh").Visible = False '全审
.Buttons("qbfq").Visible = False '全弃
.Buttons("fgh6").Visible = False '分隔行
.Buttons("fgh7").Visible = False '分隔行
.Buttons("first").Visible = False '首张
.Buttons("prev").Visible = False '上张
.Buttons("next").Visible = False '下张
.Buttons("last").Visible = False '末张
.Buttons("fgh5").Visible = False '分割行
End With
Call Sub_ShowBill
'设置操作状态为浏览
Lab_OperStatus.Caption = "1"
'设置工具条状态
Call Sub_OperStatus("11")
End Select
'<<]
'重 置 网 格
Call Sub_AdjustGrid
End Sub
Private Sub Sub_ShowBill() '根据当前单据号显示整张单据内容
Dim Sqlstr As String
Dim RecTemp As New ADODB.Recordset '临时使用动态集
Dim Jsqte As Long '临时计数器
Sqlstr = "SELECT Cwzz_V_AccVouch.*,Cwzz_AccCode.Cname,Cwzz_AccCode.Measure,Gy_ForeignCurrency.ForeignCurrName AS ForeignCurrName," & _
" Gy_Person.PersonName AS PersonName, Cwzz_Item.ItemName AS ItemName,Cwzz_ItemClass.ItemClassName," & _
" Gy_Settlement.SSName AS SSName, Gy_Customer.CusName AS CusName,Gy_Supplier.SupplierName AS SupplierName,Gy_Department.DeptName as DeptName" & _
" FROM Cwzz_V_AccVouch LEFT OUTER JOIN" & _
" Cwzz_AccCode ON" & _
" Cwzz_V_AccVouch.Ccode = Cwzz_AccCode.Ccode LEFT OUTER JOIN" & _
" Gy_ForeignCurrency ON" & _
" Cwzz_V_AccVouch.ForeignCurrCode = Gy_ForeignCurrency.ForeignCurrCode LEFT OUTER Join " & _
" Gy_Person ON" & _
" Cwzz_V_AccVouch.PersonCode = Gy_Person.PersonCode LEFT OUTER JOIN" & _
" Cwzz_Item ON Cwzz_V_AccVouch.ItemClassCode = Cwzz_Item.ItemClassCode AND" & _
" Cwzz_V_AccVouch.ItemCode = Cwzz_Item.ItemCode LEFT OUTER JOIN Cwzz_ItemClass ON Cwzz_V_AccVouch.ItemClassCode = Cwzz_ItemClass.ItemClassCode LEFT OUTER JOIN" & _
" Gy_Customer ON" & _
" Cwzz_V_AccVouch.CusCode = Gy_Customer.CusCode LEFT OUTER JOIN" & _
" Gy_Supplier ON" & _
" Cwzz_V_AccVouch.SupplierCode = Gy_Supplier.SupplierCode LEFT OUTER JOIN" & _
" Gy_Department ON" & _
" Cwzz_V_AccVouch.DeptCode = Gy_Department.DeptCode LEFT OUTER JOIN" & _
" Gy_Settlement ON Cwzz_V_AccVouch.SSCode = Gy_Settlement.SSCode" & _
" Where VouchID=" & Int(Lab_VouchId.Caption) & _
" ORDER BY Cwzz_V_AccVouch.VouchId "
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With RecTemp
WglrGrid.Clear 1
If .EOF Then
Exit Sub
Else
WglrGrid.Rows = .RecordCount + WglrGrid.FixedRows
'[>>显示单据头
TextChangeLock = True
Combo_Kjqj.Text = Mid(Trim(Str(10000 + .Fields("Year"))), 2, 4) + "." + Mid(Trim(Str(100 + .Fields("Period"))), 2, 2) '会计期间
LrText(0).Text = Trim(.Fields("VouchClassCode")) '凭证类别
LrText(3).Text = Mid(Trim(Str(10000 + .Fields("VouchNo"))), 2, 4) '凭证号
If IsDate(.Fields("DDate")) Then
LrText(1).Text = Format(.Fields("Ddate"), "yyyy-mm-dd") '制单日期
End If
LrText(2).Text = Trim(Str(.Fields("Doc"))) '附单据数
Lab_Bill.Caption = Trim(.Fields("Bill") & "") '制单人
If .Fields("CheckFlag") Then
Lab_Checker.Caption = Trim(.Fields("Checker") & "") '审核人
Else
Lab_Checker.Caption = ""
End If
If .Fields("BookFlag") Then
Lab_Book.Caption = Trim(.Fields("Book") & "") '记帐人
Else
Lab_Book.Caption = ""
End If
If .Fields("ErrorFlag") Then '是否为有错凭证
Lab_Error.Visible = True
Else
Lab_Error.Visible = False
End If
TextChangeLock = False
'<<]
End If
Jsqte = WglrGrid.FixedRows
Do While Not .EOF
If Jsqte >= WglrGrid.Rows Then
WglrGrid.AddItem ""
End If
'[>>显示单据分录
WglrGrid.TextMatrix(Jsqte, 0) = "*" '行标识
WglrGrid.TextMatrix(Jsqte, 1) = Trim(.Fields("SScode") & "") '结算方式编码
WglrGrid.TextMatrix(Jsqte, 2) = Trim(.Fields("SSname") & "") '结算方式名称
WglrGrid.TextMatrix(Jsqte, 3) = Trim(.Fields("BillNo") & "") '票号
If IsDate(.Fields("BillDate")) Then
WglrGrid.TextMatrix(Jsqte, 4) = Format(.Fields("BillDate"), "yyyy-mm-dd") '发生日期
End If
If .Fields("Jfsl") <> 0 Then
WglrGrid.TextMatrix(Jsqte, 5) = Trim(Str(.Fields("Jfsl"))) '数量
End If
If .Fields("Dfsl") <> 0 Then
WglrGrid.TextMatrix(Jsqte, 5) = Trim(Str(.Fields("Dfsl"))) '数量
End If
WglrGrid.TextMatrix(Jsqte, 7) = Trim(.Fields("Measure") & "") '计量单位
'币种为外币时填充网格
If Trim(.Fields("ForeignCurrCode") & "") <> XtSCurrCode Then
WglrGrid.TextMatrix(Jsqte, 8) = Trim(.Fields("ForeignCurrCode") & "") '原币编码
WglrGrid.TextMatrix(Jsqte, 9) = Trim(.Fields("ForeignCurrName") & "") '原币名称
If .Fields("Wbjfje") <> 0 Then
WglrGrid.TextMatrix(Jsqte, 10) = Trim(Str(.Fields("Wbjfje"))) '原币金额
End If
If .Fields("Wbdfje") <> 0 Then
WglrGrid.TextMatrix(Jsqte, 10) = Trim(Str(.Fields("Wbdfje"))) '原币金额
End If
If .Fields("AccRate") <> 0 Then
WglrGrid.TextMatrix(Jsqte, 11) = Trim(Str(.Fields("AccRate"))) '记帐汇率
End If
End If
WglrGrid.TextMatrix(Jsqte, 12) = Trim(.Fields("DeptCode") & "") '部门编码
WglrGrid.TextMatrix(Jsqte, 13) = Trim(.Fields("DeptName") & "") '部门名称
WglrGrid.TextMatrix(Jsqte, 14) = Trim(.Fields("CusCode") & "") '客户编码
WglrGrid.TextMatrix(Jsqte, 15) = Trim(.Fields("CusName") & "") '客户名称
WglrGrid.TextMatrix(Jsqte, 25) = Trim(.Fields("SupplierCode") & "") '供应商编码
WglrGrid.TextMatrix(Jsqte, 26) = Trim(.Fields("SupplierName") & "") '供应商名称
WglrGrid.TextMatrix(Jsqte, 16) = Trim(.Fields("PersonCode") & "") '职员编码
WglrGrid.TextMatrix(Jsqte, 17) = Trim(.Fields("PersonName") & "") '职员名称
WglrGrid.TextMatrix(Jsqte, 18) = Trim(.Fields("ItemClassCode") & "") '项目类别编码
WglrGrid.TextMatrix(Jsqte, 19) = Trim(.Fields("ItemClassName") & "") '项目类别名称
WglrGrid.TextMatrix(Jsqte, 20) = Trim(.Fields("ItemCode") & "") '项目编码
WglrGrid.TextMatrix(Jsqte, 21) = Trim(.Fields("ItemName") & "") '项目名称
If .Fields("ItemJfsl") <> 0 Then
WglrGrid.TextMatrix(Jsqte, 22) = Trim(Str(.Fields("ItemJfsl"))) '项目数量
End If
If .Fields("ItemDfsl") <> 0 Then
WglrGrid.TextMatrix(Jsqte, 22) = Trim(Str(.Fields("ItemDfsl"))) '项目数量
End If
WglrGrid.TextMatrix(Jsqte, 24) = Trim(.Fields("TranPerson") & "") '经办人
WglrGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("Digest")) '摘 要
WglrGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("Ccode")) '科目编码
WglrGrid.TextMatrix(Jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("Cname") & "") '科目名称
If .Fields("Jfje") <> 0 Then
WglrGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Trim(Str(.Fields("Jfje"))) '借方金额
Else
WglrGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = Trim(Str(.Fields("Dfje"))) '贷方金额
End If
'<<]
WglrGrid.RowHeight(Jsqte) = Sjhgd
.MoveNext
Jsqte = Jsqte + 1
Loop
End With
'调整网格
Call Sub_AdjustGrid
'显示备注信息
Call Sub_ShowMemo(WglrGrid.Row)
'计算合计数据
For Jsqte = Qslz To WglrGrid.Cols - 1
Call Sjhj(Jsqte)
Next Jsqte
'合计金额大写显示
HjGrid.TextMatrix(0, Sydz("003", GridStr(), Szzls)) = Fun_Jezh(Val(HjGrid.TextMatrix(0, Sydz("004", GridStr(), Szzls))))
End Sub
Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button) '用户点击工具条
'屏蔽文本框,下拉组合框有效性判断
Valilock = True
'屏蔽网格失去焦点产生的有效性判断
changelock = True
Select Case Button.Key
Case "ymsz" '页面设置
TextValiLock = True
Dyymctbl.Show 1
TextValiLock = False
Case "yl" '预 览
If Fun_Drfrmyxxpd Then
Call bbyl(True)
End If
Case "dy" '打 印
If Fun_Drfrmyxxpd Then
Call bbyl(False)
End If
Case "xz" '新 增
Call Sub_AddBill
Case "xg" '修 改
Call Sub_EditBill
Case "sc" '删 除
Call Sub_DeleteBill
Case "zh" '增 行
Call zjlrfl
Case "sh" '删 行
Call Scdqfl
Case "bc" '保 存
If Fun_Drfrmyxxpd Then
Call Sub_SaveBill
End If
Case "fq" '放 弃
Call Sub_AbandonBill
Case "cx" '查 询
Call Sub_QueryBill
Case "ye" '余 额
TextValiLock = True
PZ_FrmYecx.Show 1
TextValiLock = False
Case "xx" '选 项
TextValiLock = True
Call Sub_Option
TextValiL⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -