自动还款.frm

财务信息管理系统,适合做毕业论文的人使用

        'Unload Me
        Exit Sub
    End If
error0:
    MsgBox "数据初始化失败！" & Err.Description & "请退出重新进入！", vbInformation, "自动还款"
    Call InitNoDataForm
    'Unload Me
    Exit Sub

End Sub
    
'设置界面初始状态
Private Sub InitForm()
    Txthkrq.Enabled = False
    Txtdjmc.Enabled = False
    Txtdjmc.Text = SystemInfo(3)
    cmdrefDjmc.Enabled = False
    cmdrefDjmc.Visible = False
    With SuperGrid1
        .top = Txthkrq.top + Txthkrq.Height + 100
        .left = tlbTool.left
        If FrmAutoReturn.width > 200 Then
            .width = FrmAutoReturn.width - 200
        End If
'        If Me.WindowState = 1 Or Me.WindowState = 2 Then
'            FrmAutoReturn.Height = ScaleWidth
'        End If
        If FrmAutoReturn.Height > tlbTool.Height + Txthkrq.Height + TxtcUsername.Height + 2000 Then
            .Height = FrmAutoReturn.Height - tlbTool.Height - Txthkrq.Height - TxtcUsername.Height - 2000
        End If
        .ReadOnly = True
'        .colwidth(0) = 1500
        .SetColProperty 0, 20
'        .colwidth(1) = 1000
        .SetColProperty 1, 20
'        .colwidth(2) = 1500
        .SetColProperty 2, 20
'        .colwidth(3) = 1400
        .SetColProperty 3, 15
'        .colwidth(4) = 1400
        .SetColProperty 4, 15
'        .colwidth(5) = 1450
        .SetColProperty 5, 20
'        .colwidth(6) = 1000
        .SetColProperty 6, 15
'        .colwidth(7) = 1400
        .SetColProperty 7, 15
'        .colwidth(9) = 1700
        .SetColProperty 9, 19, DblBrowButton, EditDbl, 2
'        .colwidth(10) = 1700
        .SetColProperty 10, 19, DblBrowButton, EditDbl, 2
        .Refresh
    End With
    TxtcUsername.left = Txthkrq.left
    TxtcUsername.top = SuperGrid1.top + SuperGrid1.Height + 50
    TxtOprDate.left = Txtdjmc.left
    TxtOprDate.top = SuperGrid1.top + SuperGrid1.Height + 50
    TxtcUsername.Enabled = False
    TxtOprDate.Enabled = False
    Label3.top = TxtcUsername.top + 50
    Label3.left = Label1.left
    Label4.top = TxtOprDate.top + 50
    Label4.left = Label2.left
    With tlbTool
        .Buttons("print").Enabled = True
        .Buttons("preview").Enabled = True
        .Buttons("output").Enabled = True
        .Buttons("modify").Enabled = True
        .Buttons("save").Enabled = True
        .Buttons("linkquery").Enabled = False
        .Buttons("help").Enabled = True
        .Buttons("exit").Enabled = True
    End With
End Sub
'无数据或不允许自动还款时设置桌面
Private Sub InitNoDataForm()
    Txthkrq.Enabled = False
    Txtdjmc.Enabled = False
    curRow = 0
    Nodata = True
    With SuperGrid1
        .top = Txthkrq.top + Txthkrq.Height + 100
        .left = tlbTool.left + 100
        .width = ScaleWidth - 200
        .Height = ScaleHeight - tlbTool.Height - Txthkrq.Height - 400
        .SetColProperty 0, 30
        .SetColProperty 1, 28
        .SetColProperty 2, 10
        .SetColProperty 3, 15
        .SetColProperty 4, 15
        .SetColProperty 5, 20
        .SetColProperty 6, 15
        .SetColProperty 7, 15
        .SetColProperty 9, 19, DblBrowButton, EditDbl
        .SetColProperty 10, 19, DblBrowButton, EditDbl
        .ReadOnly = True
    End With
    With tlbTool
        .Buttons("print").Enabled = False
        .Buttons("preview").Enabled = False
        .Buttons("output").Enabled = False
        .Buttons("modify").Enabled = False
        .Buttons("save").Enabled = False
        .Buttons("linkquery").Enabled = False
        .Buttons("help").Enabled = True
        .Buttons("exit").Enabled = True
    End With
End Sub

'分解设置还款顺序
Private Sub parseReturnOrder(ByVal str As String)
    '取选项设置中的排序字段
    If mID(str, 1, 1) = "0" Then
        orderStr = "bill_Date" '按贷款日期排序
    Else
        orderStr = "sum_mny" '按结欠金额排序
    End If
    '取选项设置中的排序方式
    If mID(str, 2, 1) = "0" Then
        l_orderStyle = False  '升序
    Else
        l_orderStyle = False  '降序
    End If
    '取选项设置中的还款顺序
    Select Case mID(str, 3, 1)
        Case "0"
            l_returnSort = 0   '先本金
        Case "1"
            l_returnSort = 1   '先利息
        Case "2"
            l_returnSort = 2   '一并归还
    End Select
End Sub


'将后台数据装入前台数组
Private Function LoadtoArray() As Boolean
    Dim rs1 As New ADODB.Recordset
    Dim i As Integer
    On Error GoTo error0
    sqlstr = "select transactions_id,transactions_code,bill_date,pay_acc_id,rcv_acc_id,sum_mny,commission_mny,"
    sqlstr = sqlstr & "exchange_rate,correspond_vch_id,irate_id,cad_id,from_date,to_date,return_date,calcType_flag,"
    sqlstr = sqlstr & "settle_code,userdefine21,bill_name,cAccId,cAccName,cUnitName,deficit_flag,deficit_mny,"
    sqlstr = sqlstr & "equalsubject_code,mb,money_name from Fd_AutoReturn Where settle_Flag=0  and book_name<>''"
    'sqlstr = "select cUnitName,transactions_id,from_date,jqbj_mny,jqlx_mny,pay_acc_id,"
    'sqlstr = sqlstr & "mb,(mb-deficit_mny) As ksyye_mny from Fd_AutoReturn Where settle_Flag=0 "
    'sqlstr = sqlstr & "mb,deficit_mny from Fd_AutoReturn Where settle_Flag=0 and transactions_id like '41%' "
    sqlstr = sqlstr & "order by cunitname,pay_Acc_id,"
    If l_orderStyle Then
        sqlstr = sqlstr & orderStr & "Desc;"
    Else
        sqlstr = sqlstr & orderStr & " Asc;"
    End If
    rs.Open sqlstr, con, adOpenDynamic, adLockOptimistic
    If rs.RecordCount <> 0 Then
        SuperGrid1.Rows = rs.RecordCount + 1
        ReDim GridData(rs.RecordCount - 1, 31)
    Else
        MsgBox "目前没有需自动还款的记录！", vbInformation, "自动还款"
        LoadtoArray = False
        rs.Close
        'Unload Me
        Exit Function
    End If
    For i = 0 To UBound(GridData)
        GridData(i, 0) = IIf(IsNull(rs("cUnitName")), "", Trim(rs("cUnitName")))
        GridData(i, 1) = IIf(IsNull(rs("transactions_code")), "", Trim(rs("transactions_code")))
        GridData(i, 2) = IIf(IsNull(rs("Bill_date")), "", Trim(rs("Bill_date")))
        GridData(i, 5) = IIf(IsNull(rs("caccid")), 0, Trim(rs("caccid")))
        GridData(i, 6) = IIf(IsNull(rs("mb")), 0, Trim(rs("mb")))
        If Not IsNull(rs("deficit_flag")) Then
            If Not rs("deficit_flag") Then
                GridData(i, 7) = CDbl(IIf(IsNull(rs("mb")), 0, rs("mb")))
            Else
                GridData(i, 7) = CDbl(IIf(IsNull(rs("mb")), 0, rs("mb")) - CDbl(IIf(IsNull(rs("deficit_mny")), 0, Trim(rs("deficit_mny")))))
            End If
        Else
           GridData(i, 7) = CDbl(IIf(IsNull(rs("mb")), 0, rs("mb")))
        End If
        GridData(i, 8) = 0
        GridData(i, 9) = 0
        'gridData(i, 7) = IIf(IsNull(Rs("ksyye_mny")), 0, Trim(Rs("ksyye_mny")))
        GridData(i, 10) = rs("transactions_id")
        'GridData(i, 11) = Rs("bill_date")
        '实际代码
        'GridData(i, 12) = IIf(IsNull(Rs("pay_acc_id")), "", Rs("pay_acc_id"))
        '测试代码
        GridData(i, 12) = IIf(IsNull(rs("pay_acc_id")), IIf(IsNull(rs("rcv_acc_id")), "", rs("rcv_acc_id")), rs("pay_acc_id"))
        GridData(i, 13) = IIf(IsNull(rs("rcv_acc_id")), "", rs("rcv_acc_id"))
        GridData(i, 14) = IIf(IsNull(rs("sum_mny")), 0, rs("sum_mny"))
        GridData(i, 15) = IIf(IsNull(rs("commission_mny")), 0, rs("commission_mny"))

'        GridData(i, 3) = IIf(IsNull(Rs("jqbj_mny")), 0, Trim(Rs("jqbj_mny")))
'        GridData(i, 4) = IIf(IsNull(Rs("jqlx_mny")), 0, Trim(Rs("jqlx_mny")))
        '取已发生利息额
        sqlstr = "select sum(sum_mny) from fd_transactions where correspond_vch_id='" & Trim(GridData(i, 10)) & "' and "
        'sqlstr = sqlstr & "book_name<>'' and "  '取对应已审核利息单的利息总额
        sqlstr = sqlstr & "substring(transactions_id,1,2) in (select iId from fd_entities where (iBIType='52'or iDeriveBIType = '52'));"
        rs1.Open sqlstr, con, adOpenDynamic, adLockOptimistic
        If Not (rs1.EOF Or rs1.BOF) Then
            GridData(i, 4) = IIf(IsNull(rs1(0)), 0, rs1(0)) '已发生利息额
        Else
            GridData(i, 4) = 0
        End If
        rs1.Close
        '取已还本金和已还利息额
        sqlstr = "select sum(mcde_mny),sum(mcdeh_mny) from fd_transactions where correspond_vch_id='" & Trim(GridData(i, 10)) & "' and "
        'sqlstr = sqlstr & "book_name<>'' and " '取对应已审核还款单的还款总额
        sqlstr = sqlstr & "substring(transactions_id,1,2) in (select iId from fd_entities where (iBIType='42' or iDeriveBIType = '42'));"
        rs1.Open sqlstr, con, adOpenDynamic, adLockBatchOptimistic
        If Not (rs1.EOF Or rs1.BOF) Then
            GridData(i, 3) = IIf(IsNull(rs1(0)), 0, rs1(0))  '已还本金
            GridData(i, 11) = IIf(IsNull(rs1(1)), 0, rs1(1)) '已还利息额
        Else
            GridData(i, 3) = 0
            GridData(i, 11) = 0
        End If
        rs1.Close
        GridData(i, 16) = IIf(IsNull(rs("exchange_rate")), 1, rs("exchange_rate"))
        GridData(i, 17) = IIf(IsNull(rs("correspond_vch_id")), "", rs("correspond_vch_id"))
        GridData(i, 18) = IIf(IsNull(rs("irate_id")), "", rs("irate_id"))
        GridData(i, 19) = IIf(IsNull(rs("cad_id")), "", rs("cad_id"))
        GridData(i, 20) = IIf(IsNull(rs("to_date")), "", rs("to_date"))
        GridData(i, 21) = IIf(IsNull(rs("return_date")), "", rs("return_date"))
        GridData(i, 22) = IIf(IsNull(rs("calctype_flag")), "0", rs("calctype_Flag"))
        GridData(i, 23) = IIf(IsNull(rs("settle_code")), "", rs("settle_code"))
        GridData(i, 24) = IIf(IsNull(rs("userdefine21")), 0, rs("userdefine21"))
        GridData(i, 25) = IIf(IsNull(rs("bill_name")), "", rs("bill_name"))
        GridData(i, 26) = IIf(IsNull(rs("cAccName")), "", rs("cAccName"))
        GridData(i, 27) = IIf(IsNull(rs("deficit_flag")), 0, rs("deficit_flag"))
        GridData(i, 28) = IIf(IsNull(rs("deficit_mny")), "", rs("deficit_mny"))
        GridData(i, 29) = IIf(IsNull(rs("equalsubject_code")), "", rs("equalsubject_code"))
        GridData(i, 30) = IIf(IsNull(rs("money_Name")), "", rs("money_name"))
        sqlstr = "select scaption from fd_entities where ibitype=substring('" & CStr(GridData(i, 10)) & "', 1, 2)"
        rs1.Open sqlstr, con, adOpenDynamic
        If Not (rs.EOF Or rs.BOF) Then
            GridData(i, 31) = IIf(IsNull(rs1(0)), "", rs1(0))
        Else
            GridData(i, 31) = ""
        End If
        rs1.Close
        rs.MoveNext
    Next
    If rs.State = adStateOpen Then
        rs.Close
    End If
    LoadtoArray = True
    Exit Function
error0:
    If rs.State = adStateOpen Then
        rs.Close
    End If
    MsgBox Err.Description, vbInformation, "数据初始化错误"
    LoadtoArray = False
End Function

'计算还本金额和还本利息额
Private Sub calBlje()
    Dim i As Integer
    i = 0
    For i = 0 To UBound(GridData)
        If i = 0 Then
            Select Case l_returnSort
                Case 0
                    Call cal0(i)
                Case 1
                    Call cal1(i)
                Case 2
                    Call cal2(i)
            End Select
        Else
            If GridData(i, 5) = GridData(i - 1, 5) Then
                GridData(i, 7) = GridData(i - 1, 7) - GridData(i - 1, 8) - GridData(i - 1, 9)
            End If
            Select Case l_returnSort
                Case 0
                    Call cal0(i)
                Case 1
                    Call cal1(i)
                Case 2
                    Call cal2(i)
            End Select
        End If
    Next
End Sub

'先还本金
Private Sub cal0(ByVal i As Integer)
    If CDbl(GridData(i, 7)) < (CDbl(GridData(i, 14)) - CDbl(GridData(i, 3))) Then
        GridData(i, 8) = GridData(i, 7)
        GridData(i, 9) = 0
    ElseIf CDbl(GridData(i, 7)) >= (CDbl(GridData(i, 14)) - CDbl(GridData(i, 3))) And CDbl(GridData(i, 7)) < (CDbl(GridData(i, 14)) - CDbl(GridData(i, 3))) + (CDbl(GridData(i, 4)) - CDbl(GridData(i, 11))) Then
        GridData(i, 8) = (CDbl(GridData(i, 14)) - CDbl(GridData(i, 3)))
        GridData(i, 9) = GridData(i, 7) - GridData(i, 8)
    ElseIf CDbl(GridData(i, 7)) >= (CDbl(GridData(i, 14)) - CDbl(GridData(i, 3))) And CDbl(GridData(i, 7)) >= (CDbl(GridData(i, 14)) - CDbl(GridData(i, 3))) + (CDbl(GridData(i, 4)) - CDbl(GridData(i, 11))) Then
        GridData(i, 8) = (CDbl(GridData(i, 14)) - CDbl(GridData(i, 3)))
        GridData(i, 9) = (CDbl(GridData(i, 4)) - CDbl(GridData(i, 11)))
    End If
'    If i < SuperGrid1.Rows - 2 Then
'        If gridData(i, 5) = gridData(i + 1, 5) Then
'            gridData(i + 1, 7) = gridData(i, 7) - gridData(i, 8) - griddata(i, 9)
'        End If
'    End If
End Sub

'先还利息
Private Sub cal1(ByVal i As Integer)
    If CDbl(GridData(i, 7)) < (CDbl(GridData(i, 4)) - CDbl(GridData(i, 11))) Then
        GridData(i, 9) = GridData(i, 7)
        GridData(i, 8) = 0
    ElseIf CDbl(GridData(i, 7)) >= (CDbl(GridData(i, 4)) - CDbl(GridData(i, 11))) And CDbl(GridData(i, 7)) < CDbl((CDbl(GridData(i, 14)) - CDbl(GridData(i, 3)))) + (CDbl(GridData(i, 4)) - CDbl(GridData(i, 11))) Then
        GridData(i, 9) = GridData(i, 4)
        GridData(i, 8) = GridData(i, 7) - GridData(i, 9)
    ElseIf CDbl(GridData(i, 7)) >= CDbl((CDbl(GridData(i, 14)) - CDbl(GridData(i, 3)))) And CDbl(GridData(i, 7)) >= CDbl((CDbl(GridData(i, 14)) - CDbl(GridData(i, 3)))) + (CDbl(GridData(i, 4)) - CDbl(GridData(i, 11))) Then
        GridData(i, 8) = (CDbl(GridData(i, 14)) - CDbl((CDbl(GridData(i, 14)) - CDbl(GridData(i, 3)))))
        GridData(i, 9) = GridData(i, 4)
    End If
'    If i < SuperGrid1.Rows - 2 Then
'        If gridData(i, 5) = gridData(i + 1, 5) Then
'            gridData(i + 1, 7) = gridData(i, 7) - gridData(i, 8) - griddata(i, 9)
'        End If
'    End If
End Sub

'一并归还
Private Sub cal2(ByVal i As Integer)
    If CDbl(GridData(i, 7)) < CDbl((CDbl(GridData(i, 14)) - CDbl(GridData(i, 3)))) + (CDbl(GridData(i, 4)) - CDbl(GridData(i, 11))) Then
        GridData(i, 8) = 0