📄 单位利息汇总表.frm
字号:
"Where (FD_CadAcr.cPAccID = FD_AccDef.cAccID Or " & _
"FD_CadAcr.cGAccID = FD_AccDef.cAccID) And FD_CadAcr.cDanID Is Null And " & _
"FD_CadAcr.iDanType = 0" & " AND FD_CadAcr.dbill_date BETWEEN '" & sDate1 & _
"' AND '" & sDate2 & "'" 'Cuidong 2001.01.02
sSql1 = " GROUP BY FD_AccUnit.cUnitName,FD_AccDef.cAccID,FD_CadAcr.dbill_date,FD_AccDef.cexch_name, " & _
"FD_AccDef.iDataSrc, FD_AccSum.mb, FD_AccSum.mh_Cad,FD_CadAcr.mmoney,FD_CadAcr.cdeLx," & _
"FD_CadAcr.cCarID"
If frmInterSum.s <> "" Then
sSQL = sSQL & " AND (" & frmInterSum.s & ")" & sSql1
Else
sSQL = sSQL & sSql1
End If
Set rstInter = dbsZJ.OpenRecordset(sSQL, 2)
On Error Resume Next
rstInter.MoveLast
iNum = rstInter.RecordCount
rstInter.MoveFirst
On Error GoTo 0
sUnitN = "?"
sAccID = "?"
iRow = 2
bEqual = False
With rstInter:
bShow = False 'cuidong 2000.12.26
While Not .EOF
sql = sSqltmp & ![cAccID] & "'"
Set rstTmp = dbsZJ.OpenRecordset(sql, dbOpenSnapshot)
Sql1 = sSqlde1 & ![cCarID] & "'" & sSqlde2
Set rstCDe = dbsZJ.OpenRecordset(Sql1, dbOpenSnapshot)
' If rstCDe.RecordCount = 0 Then
' sCdelx = ""
' sDenlx = ""
' Else
dCdelx = IIf(IsNull(![cdeLx]), 0, ![cdeLx])
sCdelx = Format(dCdelx, "#,##0.00")
dDenlx = CDbl(![lxhj]) - dCdelx
sDenlx = Format(dDenlx, "#,##0.00")
' End If
' dDlxhj = dDlxhj + CDbl(sLxhj) '显示利息合计
If ![cUnitName] = sUnitN Then
If ![cAccID] = sAccID Then
bEqual = True
With UfGridado1:
' .TextMatrix(.Rows - 1, 4) = Format(CDbl(.TextMatrix(.Rows - 1, 4)) + dCjxye, "#,##0.00") '计息余额
If sJxrq <> rstInter![JXRQ] Then
.TextMatrix(.Rows - 1, 5) = Format(CDbl(.TextMatrix(.Rows - 1, 5)) + CDbl(rstInter![ZJS]), "#,##0.00") 'dCjs
End If
If .TextMatrix(.Rows - 1, 6) = "" Then
.TextMatrix(.Rows - 1, 6) = ""
Else
.TextMatrix(.Rows - 1, 6) = Format(CDbl(.TextMatrix(.Rows - 1, 6)) + dDenlx, "#,##0.00")
End If
If .TextMatrix(.Rows - 1, 7) = "" Then
.TextMatrix(.Rows - 1, 7) = ""
Else
.TextMatrix(.Rows - 1, 7) = Format(CDbl(.TextMatrix(.Rows - 1, 7)) + dCdelx, "#,##0.00")
End If
.TextMatrix(.Rows - 1, 8) = Format(CDbl(.TextMatrix(.Rows - 1, 8)) + CDbl(rstInter![lxhj]), "#,##0.00") 'dClxhj
End With
Else
If ![iDataSrc] = 0 Then
UfGridado1.AddItem "" & Chr(9) & ![cAccID] & Chr(9) & ![cexch_name] & _
Chr(9) & "" & Chr(9) & Format(![zye], "#,##0.00") & Chr(9) & _
Format(![ZJS], "#,##0.00") & Chr(9) & sDenlx & Chr(9) & sCdelx & _
Chr(9) & Format(![lxhj], "#,##0.00") 'sLxhj
ElseIf ![iDataSrc] = 1 And rstTmp.RecordCount <> 0 Then
UfGridado1.AddItem "" & Chr(9) & ![cAccID] & Chr(9) & ![cexch_name] & _
Chr(9) & IIf(rstTmp![bProperty], "借", "贷") & Chr(9) & _
Format(![zye], "#,##0.00") & Chr(9) & Format(![ZJS], "#,##0.00") & _
Chr(9) & sDenlx & Chr(9) & sCdelx & Chr(9) & Format(![lxhj], "#,##0.00") 'sLxhj
End If
End If
bShow = True 'cuidong 2000.12.26
Else
If iRow <> 2 And UfGridado1.TextMatrix(UfGridado1.Rows - 1, 1) <> "合 计" Then
If bShow Then 'Cuidong 2000.12.26
UfGridado1.AddItem "" & Chr(9) & "合 计" & Chr(9) & "" & _
Chr(9) & "" & Chr(9) & "" & Chr(9) & "" _
& Chr(9) & "" & Chr(9) & "" & Chr(9) & ""
bShow = False 'Cuidong 2000.12.26
End If 'Cuidong 2000.12.26
End If
If ![iDataSrc] = 0 Then
UfGridado1.AddItem ![cUnitName] & Chr(9) & ![cAccID] & Chr(9) & ![cexch_name] & _
Chr(9) & "" & Chr(9) & Format(![zye], "#,##0.00") & Chr(9) & _
Format(![ZJS], "#,##0.00") & Chr(9) & sDenlx & Chr(9) & sCdelx & _
Chr(9) & Format(![lxhj], "#,##0.00") 'sLxhj
bShow = True 'cuidong 2000.12.26
ElseIf ![iDataSrc] = 1 And rstTmp.RecordCount <> 0 Then
UfGridado1.AddItem ![cUnitName] & Chr(9) & ![cAccID] & Chr(9) & ![cexch_name] & _
Chr(9) & IIf(rstTmp![bProperty], "借", "贷") & Chr(9) & _
Format(![zye], "#,##0.00") & Chr(9) & Format(![ZJS], "#,##0.00") & _
Chr(9) & sDenlx & Chr(9) & sCdelx & Chr(9) & Format(![lxhj], "#,##0.00") 'sLxhj
bShow = True 'cuidong 2000.12.26
End If
End If
dCjxye = CDbl(Format(![zye], "#,##0.00"))
dCjs = CDbl(Format(![ZJS], "#,##0.00"))
If sDenlx <> "" Then dCdenlx = CDbl(sDenlx)
If sCdelx <> "" Then dCcdelx = CDbl(sCdelx)
' dClxhj = CDbl(sLxhj)
dClxhj = CDbl(![lxhj])
sUnitN = ![cUnitName]
sAccID = ![cAccID]
Handle:
If Not bEqual Then iRow = iRow + 1
iSumRec = iSumRec + 1
If iSumRec = .RecordCount Then
If bShow Then 'Cuidong 2000.12.26
UfGridado1.AddItem "" & Chr(9) & "合 计" & Chr(9) & "" & _
Chr(9) & "" & Chr(9) & "" & Chr(9) & "" _
& Chr(9) & "" & Chr(9) & "" & Chr(9) & ""
bShow = False 'Cuidong 2000.12.26
End If
'cuidong S.A 2001.09.27
'-----------------------------------
' UfGridADO1.AddItem " 总 计" & Chr(9) & "" & _
Chr(9) & "" & Chr(9) & "" & _
Chr(9) & "" & Chr(9) & "" & _
Chr(9) & "" & Chr(9) & "" & _
Chr(9) & Format(Lx_Zj, "#,##0.00")
UfGridado1.AddItem " 总 计" & Chr(9) & "" & _
Chr(9) & "" & Chr(9) & "" & _
Chr(9) & "" & Chr(9) & Format(Js_Zj, "#,##0.00") & _
Chr(9) & Format(de_Zj, "#,##0.00") & Chr(9) & Format(cde_Zj, "#,##0.00") & _
Chr(9) & Format(Lx_Zj, "#,##0.00")
'-----------------------------------
End If
bEqual = False
sJxrq = ![JXRQ]
.MoveNext
rstCDe.oClose
Set rstCDe = Nothing
Set rstTmp = Nothing
Wend
End With
'初始化表头及对齐方式
With Me.UfGridado1
.TextMatrix(0, 0) = "单位名称"
.ColAlignment(0) = UG_ALIGNLEFT
.JoinCells 0, 0, 1, 0, True
.TextMatrix(0, 1) = "账户号"
.ColAlignment(1) = UG_ALIGNCENTER
.JoinCells 0, 1, 1, 1, True
.TextMatrix(0, 2) = "币别"
.ColAlignment(2) = UG_ALIGNCENTER
.JoinCells 0, 2, 1, 2, True
.TextMatrix(0, 3) = "方向"
.ColAlignment(3) = UG_ALIGNCENTER
.JoinCells 0, 3, 1, 3, True
.TextMatrix(0, 4) = "计息余额"
.ColAlignment(4) = UG_ALIGNRIGHT
.JoinCells 0, 4, 1, 4, True
.TextMatrix(0, 5) = "积数"
.ColAlignment(5) = UG_ALIGNRIGHT
.JoinCells 0, 5, 1, 5, True
.TextMatrix(0, 6) = "定额内利息"
.ColAlignment(6) = UG_ALIGNRIGHT
.JoinCells 0, 6, 1, 6, True
.TextMatrix(0, 7) = "超定额利息"
.ColAlignment(7) = UG_ALIGNRIGHT
.JoinCells 0, 7, 1, 7, True
.TextMatrix(0, 8) = "利息合计"
.ColAlignment(8) = UG_ALIGNRIGHT
.JoinCells 0, 8, 1, 8, True
.HeadForeColor = &H404040
.HeadBackColor = &H8000000E
.HeadFont.Name = "宋体"
.HeadFont.Size = 9
.HeadFont.Bold = True
End With
EstimateDE
Lx_Hj
deLx_Hj 'cuidong S.A 2001.09.27
cdeLx_Hj 'cuidong S.A 2001.09.27
Js_Hj 'cuidong S.A 2001.09.27
Set rstInter = Nothing
Set rstTmp = Nothing
Me.UfGridado1.ColWidth(4) = 0
If UfGridado1.Rows >= 3 Then 'Cuidong 2001.01.02
On Error Resume Next 'Cuidong 2001.01.02
UfGridado1.Row = 2 'Cuidong 2001.01.02
End If 'Cuidong 2001.01.02
End Sub
'判断是否显示定额相关项
Private Sub EstimateDE()
Dim sSQL As String
Dim rstDE As New UfRecordset
sSQL = "SELECT DISTINCT FD_AccDef.cAccID,FD_Intras.bde FROM FD_Intras INNER JOIN " & _
"(FD_CadAcr INNER JOIN (FD_AccSum INNER JOIN (FD_AccDef INNER JOIN FD_AccUnit " & _
"ON FD_AccDef.cUnitCode=FD_AccUnit.cUnitCode) ON FD_AccSum.cAccID=FD_AccDef.cAccID) " & _
"ON FD_CadAcr.dbill_date-1=FD_AccSum.dbill_date) ON FD_Intras.cIntrID=FD_CadAcr.cIntrID " & _
"Where FD_CadAcr.cGAccID = FD_AccDef.cAccID " & _
"And FD_CadAcr.cDanID Is Null And FD_CadAcr.iDanType = 0 And FD_Intras.bDe <>0"
Set rstDE = dbsZJ.OpenRecordset(sSQL, dbOpenSnapshot)
On Error Resume Next
rstDE.MoveLast
On Error GoTo 0
If rstDE.RecordCount = 0 Then
Me.UfGridado1.ColWidth(6) = 0
Me.UfGridado1.ColWidth(7) = 0
End If
rstDE.oClose
Set rstDE = Nothing
End Sub
'cuidong S.A 2001.09.27
'积数总计
Private Function Js_Zj() As String
Dim i As Integer
Dim dSum As Double
With UfGridado1:
For i = 2 To .Rows - 2
If .TextMatrix(i, 1) <> "合 计" Then
dSum = dSum + CDbl(.TextMatrix(i, 5))
End If
Next i
End With
Js_Zj = Format(dSum, "#,##0.00")
End Function
'cuidong S.A 2001.09.27
'定额总计
Private Function de_Zj() As String
Dim i As Integer
Dim dSum As Double
With UfGridado1:
For i = 2 To .Rows - 2
If .TextMatrix(i, 1) <> "合 计" Then
dSum = dSum + CDbl(.TextMatrix(i, 6))
End If
Next i
End With
de_Zj = Format(dSum, "#,##0.00")
End Function
'cuidong S.A 2001.09.27
'超定额总计
Private Function cde_Zj() As String
Dim i As Integer
Dim dSum As Double
With UfGridado1:
For i = 2 To .Rows - 2
If .TextMatrix(i, 1) <> "合 计" Then
dSum = dSum + CDbl(.TextMatrix(i, 7))
End If
Next i
End With
cde_Zj = Format(dSum, "#,##0.00")
End Function
'利息总计
Private Function Lx_Zj() As String
Dim i As Integer
Dim dSum As Double
With UfGridado1:
For i = 2 To .Rows - 2
If .TextMatrix(i, 1) <> "合 计" Then
dSum = dSum + CDbl(.TextMatrix(i, 8))
End If
Next i
End With
Lx_Zj = Format(dSum, "#,##0.00")
End Function
'积数合计
Private Sub Js_Hj()
Dim i As Integer
Dim dSum As Double
With UfGridado1:
For i = 2 To .Rows - 2
If .TextMatrix(i, 1) <> "合 计" Then
dSum = dSum + CDbl(.TextMatrix(i, 5))
Else
.TextMatrix(i, 5) = Format(dSum, "#,##0.00")
dSum = 0
End If
Next i
End With
End Sub
'定额利息合计
Private Sub deLx_Hj()
Dim i As Integer
Dim dSum As Double
With UfGridado1:
For i = 2 To .Rows - 2
If .TextMatrix(i, 1) <> "合 计" Then
dSum = dSum + CDbl(.TextMatrix(i, 6))
Else
.TextMatrix(i, 6) = Format(dSum, "#,##0.00")
dSum = 0
End If
Next i
End With
End Sub
'定额利息合计
Private Sub cdeLx_Hj()
Dim i As Integer
Dim dSum As Double
With UfGridado1:
For i = 2 To .Rows - 2
If .TextMatrix(i, 1) <> "合 计" Then
dSum = dSum + CDbl(.TextMatrix(i, 7))
Else
.TextMatrix(i, 7) = Format(dSum, "#,##0.00")
dSum = 0
End If
Next i
End With
End Sub
'利息合计
Private Sub Lx_Hj()
Dim i As Integer
Dim dSum As Double
With UfGridado1:
For i = 2 To .Rows - 2
If .TextMatrix(i, 1) <> "合 计" Then
dSum = dSum + CDbl(.TextMatrix(i, 8))
Else
.TextMatrix(i, 8) = Format(dSum, "#,##0.00")
dSum = 0
End If
Next i
End With
End Sub
'规范化列表显示
Private Sub UfGridado1_CanSizeCol(ByVal nCol As Long, bSize As Boolean)
If nCol = 4 Then bSize = False
If Me.UfGridado1.ColWidth(6) = 0 And Me.UfGridado1.ColWidth(7) = 0 And (nCol = 6 Or nCol = 7) Then bSize = False
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -