📄 -
字号:
CxbbGrid.TextMatrix(jsqte, Sydz("014", GridStr(), Szzls)) = Trim(.Fields("PersonName") & "") '经办人
'读取当前会计期间
GetPeriod = .Fields("Period")
'统计本月合计数据项和本年累计数据项
MonthTotal(1) = MonthTotal(1) + .Fields("YbYsje") '原币本月应收合计
MonthTotal(2) = MonthTotal(2) + .Fields("BbYsje") '本币本月应收合计
MonthTotal(3) = MonthTotal(3) + .Fields("YbSsje") '原币本月实收合计
MonthTotal(4) = MonthTotal(4) + .Fields("BbSsje") '本币本月实收合计
YearTotal(1) = YearTotal(1) + .Fields("YbYsje") '原币本年应收累计
YearTotal(2) = YearTotal(2) + .Fields("BbYsje") '本币本年应收累计
YearTotal(3) = YearTotal(3) + .Fields("YbSsje") '原币本年应收累计
YearTotal(4) = YearTotal(4) + .Fields("BbSsje") '本币本年应收累计
'<<]
'动态集指针加1,同时将计数器加1(Fixed)
.MoveNext
jsqte = jsqte + 1
'如果会计期间发生变化,则显示本月和本年的合计内容
If .EOF Then
'输出本月合计数据
CxbbGrid.AddItem ""
Call Sub_MonthTotal(jsqte)
jsqte = jsqte + 1
'输出本年累计数据
CxbbGrid.AddItem ""
Call Sub_YearTotal(jsqte)
jsqte = jsqte + 1
Else
If (GetPeriod <> .Fields("Period")) And GetPeriod <> 0 Then
'输出本月合计数据
CxbbGrid.AddItem ""
Call Sub_MonthTotal(jsqte)
jsqte = jsqte + 1
'输出本年累计数据
CxbbGrid.AddItem ""
Call Sub_YearTotal(jsqte)
jsqte = jsqte + 1
End If
End If
Loop
End With
'清空临时数据
For I = 1 To 4
MonthTotal(I) = 0
YearTotal(I) = 0
Next I
YbNcye = 0
BbNcye = 0
GetPeriod = 0
TempForCur = ""
']以上为用户自定义部分
End Sub
'输出本月合计数据
Private Sub Sub_MonthTotal(jsqte As Integer)
With CxbbGrid
'输出本月合计
.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = GetPeriod '会计期间
.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = "本月合计" '摘要
.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = MonthTotal(2) '本币应收本月合计
.TextMatrix(jsqte, Sydz("009", GridStr(), Szzls)) = MonthTotal(4) '本币实收本月合计
If TempForCur <> XtSCurrCode Then
.TextMatrix(jsqte, Sydz("006", GridStr(), Szzls)) = MonthTotal(1) '原币应收本月合计
.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)) = MonthTotal(3) '原币实收本月合计
If BbNcye <> 0 Then
.TextMatrix(jsqte, Sydz("011", GridStr(), Szzls)) = Abs(YbNcye) '原币期末余额
End If
End If
'输出借贷方向
If BbNcye <> 0 Then
If BbNcye < 0 Then '借贷方向
.TextMatrix(jsqte, Sydz("010", GridStr(), Szzls)) = "贷"
Else
.TextMatrix(jsqte, Sydz("010", GridStr(), Szzls)) = "借"
End If
Else
.TextMatrix(jsqte, Sydz("010", GridStr(), Szzls)) = "平"
End If
If BbNcye <> 0 Then
.TextMatrix(jsqte, Sydz("012", GridStr(), Szzls)) = Abs(BbNcye) '本币期末余额
End If
'设置本月合计的颜色
.Cell(flexcpBackColor, jsqte, 0, , CxbbGrid.Cols - 1) = "&H00F7F3EC"
End With
'清空本月合计
For I = 1 To 4
MonthTotal(I) = 0
Next I
End Sub
'输出本年累加数据
Private Sub Sub_YearTotal(jsqte As Integer)
With CxbbGrid
'输出本年累计
.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = GetPeriod '会计期间
.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = "本年累计" '摘要
.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = YearTotal(2) '本币应收本月合计
.TextMatrix(jsqte, Sydz("009", GridStr(), Szzls)) = YearTotal(4) '本币实收本月合计
If TempForCur <> XtSCurrCode Then
.TextMatrix(jsqte, Sydz("006", GridStr(), Szzls)) = YearTotal(1) '原币应收本月合计
.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)) = YearTotal(3) '原币实收本月合计
If BbNcye <> 0 Then
.TextMatrix(jsqte, Sydz("011", GridStr(), Szzls)) = Abs(YbNcye) '原币期末余额
End If
End If
'输出借贷方向
If BbNcye <> 0 Then
If BbNcye < 0 Then '借贷方向
.TextMatrix(jsqte, Sydz("010", GridStr(), Szzls)) = "贷"
Else
.TextMatrix(jsqte, Sydz("010", GridStr(), Szzls)) = "借"
End If
Else
.TextMatrix(jsqte, Sydz("010", GridStr(), Szzls)) = "平"
End If
If BbNcye <> 0 Then
.TextMatrix(jsqte, Sydz("012", GridStr(), Szzls)) = Abs(BbNcye) '本币期末余额
End If
'设置本年累计的颜色
.Cell(flexcpBackColor, jsqte, 0, , CxbbGrid.Cols - 1) = "&H00C0E0FF"
End With
End Sub
'根据单据类型显示单据信息
Private Sub CxbbGrid_DblClick() '用户双击网格调入相应单据
Dim RecTemp As New ADODB.Recordset '临时使用动态集
'当第一次查询结果为空时,判断总记录行是否与固定行数相同,如相同则不能显示单据(双表头出现此情况)
If CxbbGrid.Rows = CxbbGrid.FixedRows Then
Exit Sub
End If
'非数据行或者单据号为空退出
If CxbbGrid.Row < CxbbGrid.FixedRows Or Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("003", GridStr(), Szzls))) = "" Then
Exit Sub
End If
'根据查询结果显示相应的单据
Select Case Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("002", GridStr(), Szzls)))
Case "其他应收单", "代垫费用单"
Sqlstr = "SELECT OtherBillId,BillItemCode From RP_OtherBill Where BillCode='" & CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("003", GridStr(), Szzls)) & "'"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With RecTemp
If .EOF Then
Tsxx = "此单据已被其他用户删除!"
Call Xtxxts(Tsxx, 0, 4)
Exit Sub
Else
'调入单据处理窗体
If Trim(.Fields!BillItemCode) = "21" Then
'调入代垫费用单
With ArNote_FrmFareBill
'填充查询单据标识
XT_BillID = Val(RecTemp.Fields!OtherBillId)
'设置单据处理为明细联查查询(修改)状态
Xtcdcs = "3"
.Show 1
End With
ElseIf Trim(.Fields!BillItemCode) = "20" Then
'调入其他应收单
With ArNote_FrmOtherBill
'填充查询单据标识
XT_BillID = Val(RecTemp.Fields!OtherBillId)
'设置单据处理为列表查询(修改)状态
Xtcdcs = "3"
.Show 1
End With
End If
End If
End With
Case "到款单", "退款单", "预收单"
Sqlstr = "SELECT CloseBillID From RP_CloseBill Where BillCode='" & CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("003", GridStr(), Szzls)) & "'"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With RecTemp
If .EOF Then
Tsxx = "此结算单已被其他用户删除!"
Call Xtxxts(Tsxx, 0, 4)
Exit Sub
Else
'调入单据处理窗体
With SK_FrmJsdcl
'填充查询单据标识
XT_BillID = Val(RecTemp.Fields!CloseBillId)
'设置单据处理为列表查询(修改)状态
Xtcdcs = "3"
.Show 1
End With
End If
End With
Case "普通发票"
Sqlstr = "SELECT InvoiceBillMainID,returnflag From Xs_InvoiceBillMain Where InvoiceCode='" & CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("003", GridStr(), Szzls)) & "'"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With RecTemp
If .EOF Then
Tsxx = "此发票已被其他用户删除!"
Call Xtxxts(Tsxx, 0, 4)
Exit Sub
Else
XT_BillID = Val(RecTemp.Fields!InvoiceBillMainID) '填充查询单据标识
Xtcdcs = "3" '设置单据处理为列表查询(修改)状态
'调入单据处理窗体
If Trim(.Fields("returnflag")) Then
Xtcdcsfz = Str_QueryCondi & " and returnflag = 1"
Xs_I_RedInvoice.Show 1
Else
Xtcdcsfz = Str_QueryCondi & " and returnflag = 0"
Xs_I_InvoiceBill.Show 1
End If
End If
End With
Case "专用发票"
Sqlstr = "SELECT InvoiceBillMainID,returnflag From Xs_InvoiceBillMain Where InvoiceCode='" & CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("003", GridStr(), Szzls)) & "'"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With RecTemp
If .EOF Then
Tsxx = "此发票已被其他用户删除!"
Call Xtxxts(Tsxx, 0, 4)
Exit Sub
Else
XT_BillID = Val(RecTemp.Fields!InvoiceBillMainID) '填充查询单据标识
Xtcdcs = "3" '设置单据处理为列表查询(修改)状态
'调入单据处理窗体
If Trim(.Fields("returnflag")) Then
Xtcdcsfz = Str_QueryCondi & " and returnflag = 1"
Xs_I_UseRedInvoice.Show 1
Else
Xtcdcsfz = Str_QueryCondi & " and returnflag = 0"
Xs_I_UseInvoice.Show 1
End If
End If
End With
Case Else
Exit Sub
End Select
End Sub
'[>>===================以下为根据实际业务需要自定义过程区域=============================<<]
Private Sub bbyl(bbylte As Boolean) '报表打印预览
Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
Bbxbtgs = 2 '报 表 小 标 题 行 数
Bbbwhgs = 0 '报 表 表 尾 行 数
ReDim Bbxbt(1 To Bbxbtgs)
ReDim bbxbtzzxs(1 To Bbxbtgs)
If Bbbwhgs <> 0 Then
ReDim Bbbwh(1 To Bbbwhgs)
ReDim Bbbwhzzxs(1 To Bbbwhgs)
End If
Bbzbt = ReportTitle
Bbxbt(1) = Space(2) + Fun_FormatOutPut(Lab_Cust, 40) + Fun_FormatOutPut(Lab_Foreign, 20)
bbxbtzzxs(1) = 0 '报表行组织形式(0-居左 1-居中 2-居右)
Call Scyxsjb(CxbbGrid) '生成报表数据
Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
If Not bbylte Then
Unload DY_Tybbyldy
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -