【住房貸款等額本金計算】【住房貸款等額本息計算】【自定義生成表】
住房貸款等額本金計算
Private Sub Command計算_Click()
'房款總額
If Me.房款總額 <> "" Then
? ? If IsNumeric(Me.房款總額) = False Then
? ? ? ? MsgBox "me.房款總額只能為數(shù)字"
? ? ? ? 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.貸款年利率只能為數(shù)字"
? ? ? ? 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 還款期數(shù)data As Integer
If Me.房款總額 <> "" And Me.按揭成數(shù) <> "" And Me.按揭年數(shù) <> "" And Me.貸款年利率 <> "" And Me.利率折扣 <> "" Then
Else
MsgBox "數(shù)據(jù)未填寫完成"
Exit Sub
End If
房款總額data = Me.房款總額 * 10000
貸款總額data = 房款總額data * Me.按揭成數(shù) / 10
還款期數(shù)data = Me.按揭年數(shù) * 12
月利率data = (Me.貸款年利率 / 100) / 12 * (Me.利率折扣 / 100)
每期還本金額data = 貸款總額data / 還款期數(shù)data
'清空列表框
Dim i
For i = Me.List還款明細.ListCount - 1 To 0 Step -1
? ? Me.List還款明細.RemoveItem (i)
Next i
'輸出標題
Me.List還款明細.AddItem "期數(shù)" & ";" & "本金" & ";" & "利息" & ";" & "總額"
'計算每期數(shù)據(jù)
Dim a1, a2, a3, a4
For i = 0 To 還款期數(shù)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 按揭年數(shù)=" & Me.按揭年數(shù))
Else
Me.貸款年利率 = DLookup("利率", "利率表", "貸款類型='商業(yè)住房貸款' and 按揭年數(shù)=" & Me.按揭年數(shù))
End If
End Sub
Private Sub 按揭年數(shù)_Change()
If Me.按揭年數(shù) <> "" 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.房款總額只能為數(shù)字"
? ? ? ? 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.貸款年利率只能為數(shù)字"
? ? ? ? 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.按揭成數(shù) <> "" And Me.按揭年數(shù) <> "" And Me.貸款年利率 <> "" And Me.利率折扣 <> "" Then
Else
MsgBox "數(shù)據(jù)未填寫完成"
Exit Sub
End If
Me.房款總額 = Me.房款總額萬 * 10000
Me.貸款總額 = Me.房款總額 * Me.按揭成數(shù) / 10
Me.首期付款 = Me.房款總額 * (1 - Me.按揭成數(shù) / 10)
月利率data = (Me.貸款年利率 / 1200) * (Me.利率折扣 / 100)
Me.還貸月數(shù) = Me.按揭年數(shù) * 12
每月還款data = 計算本息還款(月利率data, Me.還貸月數(shù), Me.貸款總額)
Me.月均還款 = Format(每月還款data, "####.00")
Me.還款總額 = Me.月均還款 * Me.還貸月數(shù)
Me.支付利息款 = Me.還款總額 - Me.貸款總額
End Sub
Sub 獲取利率()
On Error Resume Next
If Me.貸款類型 = 1 Then
Me.貸款年利率 = DLookup("利率", "利率表", "貸款類型='公積金住房貸款' and 按揭年數(shù)=" & Me.按揭年數(shù))
Else
Me.貸款年利率 = DLookup("利率", "利率表", "貸款類型='商業(yè)住房貸款' and 按揭年數(shù)=" & Me.按揭年數(shù))
End If
End Sub
Private Sub 按揭年數(shù)_Change()
If Me.按揭年數(shù) <> "" Then
Call 獲取利率
End If
End Sub
Function 計算本息還款(ByVal 貸款月利率 As Single, ByVal 還款期數(shù) As Integer, ByVal 貸款額 As Single) As Double
Dim i As Integer
Dim t As Double
t = 1
For i = 1 To 還款期數(shù)
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.數(shù)據(jù)表子窗體.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 "請輸入創(chuàng)建的表名稱"
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.數(shù)據(jù)表子窗體.Requery
? ? End If
Else
MsgBox "請輸入字段名稱和選擇字段類型"
Exit Sub
End If
End Sub
