住房贷款等额本金计算

Private Sub Command计算_Click()

'房款总额

If Me.房款总额 <> "" Then

    If IsNumeric(Me.房款总额) = False Then

        MsgBox "me.房款总额只能为数字"

        Exit Sub

    Else

        If CSng(Me.房款总额) <= 0 Then

        MsgBox "房款总额必须大于0"

        Exit Sub

        End If

    End If

Else

MsgBox "房款总额不能为空"

Exit Sub

End If

'利率

If Me.贷款年利率 <> "" Then

    If IsNumeric(Me.贷款年利率) = False Then

        MsgBox "me.贷款年利率只能为数字"

        Exit Sub

    Else

        If CSng(Me.贷款年利率) <= 0 Then

        MsgBox "贷款年利率必须大于0"

        Exit Sub

        End If

    End If

Else

MsgBox "贷款年利率不能为空"

Exit Sub

End If

Dim 房款总额data As Single

Dim 贷款总额data As Single

Dim 每期还本金额data As Single

Dim 每月利息data As Single

Dim 折扣利率data As Single

Dim 月利率data As Single

Dim 还款期数data As Integer

If Me.房款总额 <> "" And Me.按揭成数 <> "" And Me.按揭年数 <> "" And Me.贷款年利率 <> "" And Me.利率折扣 <> "" Then

Else

MsgBox "数据未填写完成"

Exit Sub

End If

房款总额data = Me.房款总额 * 10000

贷款总额data = 房款总额data * Me.按揭成数 / 10

还款期数data = Me.按揭年数 * 12

月利率data = (Me.贷款年利率 / 100) / 12 * (Me.利率折扣 / 100)

每期还本金额data = 贷款总额data / 还款期数data

'清空列表框

Dim i

For i = Me.List还款明细.ListCount - 1 To 0 Step -1

    Me.List还款明细.RemoveItem (i)

Next i

'输出标题

Me.List还款明细.AddItem "期数" & ";" & "本金" & ";" & "利息" & ";" & "总额"

'计算每期数据

Dim a1, a2, a3, a4

For i = 0 To 还款期数data - 1

 每月利息data = (贷款总额data - i * 每期还本金额data) * 月利率data

 a1 = i + 1

 a2 = Format(每期还本金额data, "####.00")

 a3 = Format(每月利息data, "####.00")

 a4 = Format(每期还本金额data + 每月利息data, "####.00")

 Me.List还款明细.AddItem a1 & ";" & a2 & ";" & a3 & ";" & a4

Next i

End Sub

Sub 获取利率()

On Error Resume Next

If Me.贷款类型 = 1 Then

Me.贷款年利率 = DLookup("利率", "利率表", "贷款类型='公积金住房贷款' and 按揭年数=" & Me.按揭年数)

Else

Me.贷款年利率 = DLookup("利率", "利率表", "贷款类型='商业住房贷款' and 按揭年数=" & Me.按揭年数)

End If

End Sub

Private Sub 按揭年数_Change()

If Me.按揭年数 <> "" Then

Call 获取利率

End If

End Sub

Private Sub 贷款类型_AfterUpdate()

Call 获取利率

End Sub

住房贷款等额本息计算

Private Sub Command计算_Click()

'房款总额

If Me.房款总额万 <> "" Then

    If IsNumeric(Me.房款总额万) = False Then

        MsgBox "me.房款总额只能为数字"

        Exit Sub

    Else

        If CSng(Me.房款总额万) <= 0 Then

        MsgBox "房款总额必须大于0"

        Exit Sub

        End If

    End If

Else

MsgBox "房款总额不能为空"

Exit Sub

End If

'利率

If Me.贷款年利率 <> "" Then

    If IsNumeric(Me.贷款年利率) = False Then

        MsgBox "me.贷款年利率只能为数字"

        Exit Sub

    Else

        If CSng(Me.贷款年利率) <= 0 Then

        MsgBox "贷款年利率必须大于0"

        Exit Sub

        End If

    End If

Else

MsgBox "贷款年利率不能为空"

Exit Sub

End If

Dim 房款总额data As Single

Dim 贷款总额data As Single

Dim 月利率data As Single

Dim 每月还款data As Single

If Me.房款总额万 <> "" And Me.按揭成数 <> "" And Me.按揭年数 <> "" And Me.贷款年利率 <> "" And Me.利率折扣 <> "" Then

Else

MsgBox "数据未填写完成"

Exit Sub

End If

Me.房款总额 = Me.房款总额万 * 10000

Me.贷款总额 = Me.房款总额 * Me.按揭成数 / 10

Me.首期付款 = Me.房款总额 * (1 - Me.按揭成数 / 10)

月利率data = (Me.贷款年利率 / 1200) * (Me.利率折扣 / 100)

Me.还贷月数 = Me.按揭年数 * 12

每月还款data = 计算本息还款(月利率data, Me.还贷月数, Me.贷款总额)

Me.月均还款 = Format(每月还款data, "####.00")

Me.还款总额 = Me.月均还款 * Me.还贷月数

Me.支付利息款 = Me.还款总额 - Me.贷款总额

End Sub

Sub 获取利率()

On Error Resume Next

If Me.贷款类型 = 1 Then

Me.贷款年利率 = DLookup("利率", "利率表", "贷款类型='公积金住房贷款' and 按揭年数=" & Me.按揭年数)

Else

Me.贷款年利率 = DLookup("利率", "利率表", "贷款类型='商业住房贷款' and 按揭年数=" & Me.按揭年数)

End If

End Sub

Private Sub 按揭年数_Change()

If Me.按揭年数 <> "" Then

Call 获取利率

End If

End Sub

Function 计算本息还款(ByVal 贷款月利率 As Single, ByVal 还款期数 As Integer, ByVal 贷款额 As Single) As Double

Dim i As Integer

Dim t As Double

t = 1

For i = 1 To 还款期数

t = t * (1 + 贷款月利率)

Next i

计算本息还款 = 贷款月利率 * t / (t - 1) * 贷款额

End Function

Private Sub 贷款类型_AfterUpdate()

Call 获取利率

End Sub

自定义生成表

Private Sub Command清空列表_Click()

DoCmd.SetWarnings (False)

    Dim del_sql As String

    del_sql = "Delete From 字段表"

    DoCmd.RunSQL del_sql

    Me.数据表子窗体.Requery

End Sub

Private Sub Command生成表_Click()

If Me.表名称 <> "" Then

    If Nz(DCount("字段名称", "字段表"), 0) = 0 Then

    MsgBox "至少添加一个字段"

    Exit Sub

    End If

Dim a1 As String

a1 = "create table " & Me.表名称

Dim a2 As String

a2 = "("

Dim search_rs As DAO.Recordset

Dim search_sql As String

search_sql = "Select * From 字段表"

Set search_rs = CurrentDb.OpenRecordset(search_sql, dbOpenDynaset)

Do While search_rs.EOF = False

If search_rs!是否主键 = True Then

a2 = a2 & vbCrLf & search_rs!字段名称.Value & " " & search_rs!字段类型.Value & " PRIMARY KEY,"

Else

a2 = a2 & vbCrLf & search_rs!字段名称.Value & " " & search_rs!字段类型.Value & ","

End If

search_rs.MoveNext

Loop

search_rs.Close

Set search_rs = Nothing

a2 = Left(a2, Len(a2) - 1) & vbCrLf & ")"

DoCmd.SetWarnings (False)

MsgBox a1 & vbCrLf & a2

DoCmd.RunSQL a1 & vbCrLf & a2

MsgBox "生成完成"

Else

MsgBox "请输入创建的表名称"

Exit Sub

End If

End Sub

Private Sub Command添加_Click()

If Me.字段名称 <> "" And Me.字段类型 <> "" Then

    If Nz(DCount("字段名称", "字段表", "字段名称='" & Me.字段名称 & "'"), 0) > 0 Then

    MsgBox "该字段名称已存在！"

    Exit Sub

    Else

    DoCmd.SetWarnings (False)

    Dim add_sql As String

    add_sql = "Insert Into 字段表 (字段名称,字段类型,是否主键) Values ('" & 字段名称 & "','" & 字段类型 & "',false)"

    DoCmd.RunSQL add_sql

    Me.数据表子窗体.Requery

    End If

Else

MsgBox "请输入字段名称和选择字段类型"

Exit Sub

End If

End Sub