Content Supported by Sourcelens Consulting
VERSION 5.00
Object = "{0ECD9B60-23AA-11D0-B351-00A0C9055D8E}#6.0#0"; "MSHFLXGD.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmGrid
Caption = "Grid"
ClientHeight = 6885
ClientLeft = 165
ClientTop = 735
ClientWidth = 9345
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
ScaleHeight = 6885
ScaleWidth = 9345
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdPrint
Caption = "Data Report"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 1335
TabIndex = 23
Top = 1530
Width = 1500
End
Begin MSComDlg.CommonDialog dlgFont
Left = 60
Top = 1470
_ExtentX = 847
_ExtentY = 847
_Version = 393216
DialogTitle = "Change Font"
End
Begin VB.TextBox txtPrincipal
Alignment = 1 'Right Justify
BeginProperty DataFormat
Type = 1
Format = "'$'#,##0.00"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 0
SubFormatType = 0
EndProperty
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 390
Left = 1380
TabIndex = 17
TabStop = 0 'False
ToolTipText = "Principal"
Top = 1065
Width = 1380
End
Begin VB.TextBox txtDown
Alignment = 1 'Right Justify
BeginProperty DataFormat
Type = 1
Format = "'$'#,##0.00"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 0
SubFormatType = 0
EndProperty
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 390
Left = 1380
TabIndex = 16
TabStop = 0 'False
ToolTipText = "Down payment"
Top = 525
Width = 1350
End
Begin VB.CommandButton cmdCalcAmort
Caption = "Show Amortization"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 6555
TabIndex = 7
Top = 1440
Width = 2295
End
Begin VB.CommandButton cmdCalcPmts
Caption = "Calculate Payments"
Default = -1 'True
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 4050
TabIndex = 0
Top = 1440
Width = 2295
End
Begin VB.Frame frmIntr
Caption = "Interest Rates"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1335
Left = 4050
TabIndex = 13
Top = 0
Width = 2295
Begin VB.ComboBox comIntrMin
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 1440
Style = 2 'Dropdown List
TabIndex = 4
Top = 840
Width = 735
End
Begin VB.ComboBox comIntrMax
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Left = 1440
Style = 2 'Dropdown List
TabIndex = 3
Top = 360
Width = 735
End
Begin VB.Label lblIntr
Caption = "Maximum %"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 0
Left = 270
TabIndex = 15
Top = 315
Width = 1095
End
Begin VB.Label lblIntr
Caption = "Minimum %"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 1
Left = 255
TabIndex = 14
Top = 840
Width = 1095
End
End
Begin VB.Frame frmLoanLen
Caption = "Years in Loan"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1335
Left = 6555
TabIndex = 10
ToolTipText = "Double-click to switch between years and months"
Top = 0
Width = 2295
Begin VB.TextBox txtLenMin
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 1440
TabIndex = 6
Top = 840
Width = 615
End
Begin VB.TextBox txtIntMax
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 285
Left = 1440
TabIndex = 5
Top = 360
Width = 615
End
Begin VB.Label lblLen
Caption = "Minimum"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 1
Left = 240
TabIndex = 12
Top = 840
Width = 855
End
Begin VB.Label lblLen
Caption = "Maximum"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 255
Index = 0
Left = 270
TabIndex = 11
Top = 315
Width = 855
End
End
Begin VB.TextBox txtPrice
Alignment = 1 'Right Justify
BeginProperty DataFormat
Type = 1
Format = "'$'#,##0.00"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 0
SubFormatType = 0
EndProperty
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 390
Left = 1380
TabIndex = 1
ToolTipText = "The total price"
Top = 75
Width = 1335
End
Begin VB.TextBox txtPercentDown
Alignment = 1 'Right Justify
BeginProperty DataFormat
Type = 1
Format = "0.00%"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 0
SubFormatType = 0
EndProperty
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 390
Left = 2850
TabIndex = 2
ToolTipText = "A percentage of price."
Top = 525
Width = 795
End
Begin MSHierarchicalFlexGridLib.MSHFlexGrid grdPayments
Height = 4185
Left = 45
TabIndex = 8
TabStop = 0 'False
Top = 2400
Width = 9075
_ExtentX = 16007
_ExtentY = 7382
_Version = 393216
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_NumberOfBands = 1
_Band(0).Cols = 2
End
Begin VB.Label Label4
Caption = "Principal"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 270
TabIndex = 22
Top = 1170
Width = 690
End
Begin VB.Label Label3
Caption = "Down Payment"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 255
TabIndex = 21
Top = 510
Width = 900
End
Begin VB.Shape Shape1
Height = 495
Left = 75
Top = 2010
Width = 9060
End
Begin VB.Label lblMessage
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 300
Left = 255
TabIndex = 20
Top = 2025
Width = 8850
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
Caption = "="
Height = 345
Left = 1080
TabIndex = 19
Top = 1095
Width = 195
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "-"
Height = 240
Left = 1140
TabIndex = 18
Top = 525
Width = 210
End
Begin VB.Line Line2
X1 = 1425
X2 = 2715
Y1 = 1005
Y2 = 1005
End
Begin VB.Label lblPurchTotl
Caption = "Purchase Amount"
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 255
TabIndex = 9
Top = 45
Width = 900
End
Begin VB.Menu mnuFile
Caption = "File"
Begin VB.Menu mnuExit
Caption = "E&xit"
End
End
Begin VB.Menu mnuTerms
Caption = "Terms"
Begin VB.Menu mnuYears
Caption = "Years"
Checked = -1 'True
End
Begin VB.Menu mnuMonths
Caption = "Months"
End
End
Begin VB.Menu mnuHelp
Caption = "Help"
Begin VB.Menu mnuInstructions
Caption = "Instructions"
End
End
Begin VB.Menu mnuFont
Caption = "Font"
Begin VB.Menu mnuDlgFont
Caption = "Font"
End
End
End
Attribute VB_Name = "frmGrid"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' ADO Recordset objects. One for the Payments,
' and a second for Amortization.
Private rsAmort As ADODB.Recordset
Private rsPayments As ADODB.Recordset
' Form variables used to calculate and store values.
Private DownPayRate As Single ' percent down payment
Private PurchAmt As Currency ' Price
Private DPAmt As Currency ' Actual down payment.
Private LoanAmt As Currency ' Principal
' Form variables for the minimum and maximum loan lengths, in years.
Private LenMin As Integer
Private LenMax As Integer
' Form variables for the minimum and maximum interest rates.
Private IntrMin As Single
Private IntrMax As Single
' Form variables to track the number of rows and columns.
Private PeriodsCnt As Single
Private RatesCnt As Single
' Form variables for the current interest rate and period values.
Private Interest As Single
Dim Months As Single
' Form variable to hold the payment for the amortization calculation.
Dim AmortPmnt As Single
' Flags:
Private AmortFlag As Boolean ' State of grid: show Amortization schedule or not.
Private bYears As Boolean ' Schedule: either years or months.
Const FixedColWidth = 1000 ' default width of columns.
Private Sub cmdPrint_Click()
' Set the DataSource, and bind the fields
Set rptAmort.DataSource = rsAmort
' Details section:
' Assign data fields to controls in Details section
' of the DataReport designer. Controls are
' referenced by their names.
With rptAmort.Sections("Details")
.Controls("txtPrincipalPaid").DataField = "Principal Paid"
.Controls("txtInterest").DataField = "Interest"
.Controls("txtBalanceDue").DataField = "Balance Due"
.Controls("txtTotalInterest").DataField = "Total Interest"
End With
' Header section:
With rptAmort.Sections("secRptHeader")
' set Label captions for summary info. Controls are
' referenced by their names.
.Controls("lblAmount").Caption = "Principal: " & txtPrincipal
.Controls("lblInterestRate").Caption = "Interest Rate: " & FormatPercent(Interest * 12)
.Controls("lblPayment").Caption = "Payment: " & FormatCurrency(AmortPmnt)
.Controls("lblTerms").Caption = "Payments: " & Months
.Controls("lblYears").Caption = CalcMonths(Months)
End With
rptAmort.Show
End Sub
Private Function CalcMonths(m As Single) As String
' Returns the caption for the number of months,
' or years.
Select Case m
Case Is < 12
CalcMonths = m & " months"
Case 12 To 23
CalcMonths = "One year and " & m - 12 & " months"
Case Else
CalcMonths = m / 12 & " years"
End Select
End Function
Private Sub Form_Load()
Dim iRate As Single
Dim Count As Integer
AmortFlag = True
' Put the application in the center of the screen.
frmGrid.Left = (Screen.Width - frmGrid.Width) / 2
frmGrid.Top = (Screen.Height - frmGrid.Height) / 2
' Put allowed interest rates in list boxes.
For iRate = 0 To 50 Step 0.25
comIntrMin.AddItem Format(iRate, "0.00")
comIntrMax.AddItem Format(iRate, "0.00")
Next iRate
' Set the maximum and minimum interest rates:6% to 8%.
comIntrMax.ListIndex = 32
comIntrMin.ListIndex = 24
txtIntMax = 30
txtLenMin = 15
LenMin = txtLenMin
LenMax = txtIntMax
' Set the default number of rates and periods.
RatesCnt = 3
PeriodsCnt = 16
' Create a temporary recordset to assign to Datagrid control.
InitalizeRS
' Add initial values to the text boxes.
IntializeFields
CalculatePrincipal
bYears = True
End Sub
Private Sub InitalizeRS()
' Create an initial recordset, just for demonstration purposes,
' and assign it to the DataGrid control's DataSource property.
Set rsPayments = New ADODB.Recordset
With rsPayments
.Fields.Append "rate 1", adBSTR
.Fields.Append "rate 2", adBSTR
.Fields.Append "rate 3", adBSTR
.Open
rsPayments.AddNew
rsPayments![rate 1] = 0
rsPayments![rate 2] = 0
rsPayments![rate 3] = 0
End With
Dim j As Integer
Set grdPayments.DataSource = rsPayments
For j = 0 To grdPayments.Cols(0)
grdPayments.ColWidth(j) = grdPayments.Width / grdPayments.Cols(0)
Next j
End Sub
Private Sub IntializeFields()
' Set initial values of fields.
PurchAmt = 100000 ' $100,000
DownPayRate = 0.1 ' 10%
txtPrice.Text = Format(PurchAmt, "Currency")
txtPercentDown.Text = Format(DownPayRate, "Percent")
End Sub
Private Sub CalcPmnts(bTerms As Boolean)
' Declare local variables.
Dim i As Single ' Counter.
Dim j As Integer
Set rsPayments = New ADODB.Recordset
' Calculate the number of periods and interest rates to display.
PeriodsCnt = (LenMax - LenMin) + 1
RatesCnt = ((IntrMax - IntrMin) * 4) + 1
' Create fields, one for each interest rate.
For i = IntrMin To IntrMax Step 0.25
rsPayments.Fields.Append i & "%", adBSTR
Next i
rsPayments.Open
Dim tempTerms As Long
Dim tempInterest As Single
tempTerms = LenMin
' For each interest rate/loan length, calculate the payments.
For j = 1 To PeriodsCnt
rsPayments.AddNew ' Add new record.
tempInterest = IntrMin ' Reset interest rate.
For i = 0 To RatesCnt - 1 ' Calculate values prior to making calculations.
' if the term is years, then multiply by 12.
Interest = tempInterest / 1200 ' Interest rate
If bTerms Then
Months = tempTerms * 12 ' Years * 12 months
Else
Months = tempTerms ' Just months.
End If
' Set the value using the Pmt function.
rsPayments.Fields(i) = FormatCurrency(Abs(Pmt(Interest, Months, LoanAmt)))
tempInterest = tempInterest + 0.25 ' Increment interest rate.
Next i
tempTerms = tempTerms + 1
Next j
End Sub
Private Sub CalcAmort()
' Declare local variables.
' Temporary variables for calculating values.
Dim Count As Integer
Dim tempBalance As Currency
Dim tempInterest As Currency
Dim tempPaid As Currency
Dim ttlInterest As Currency
Dim j As Integer
' Save the monthly payment from the selected cell.
AmortPmnt = CSng(grdPayments.Text)
' Save the interest rate from the selected row.
Interest = CSng(Left(rsPayments.Fields(grdPayments.Col - 1).Name, Len(rsPayments.Fields(grdPayments.Col - 1).Name) - 1))
' Make the loan length match the selected cell.
grdPayments.Col = 0
Months = CInt(Left(grdPayments.Text, Len(grdPayments.Text) - Len(" years")))
' Calculate the number of periods (months). If the user is
' using months, then leave the number alone. Otherwise, multiply by 12.
If bYears Then Months = Months * 12
' Display the payment terms.
lblMessage.Caption = "Amortization schedule for: " & _
Months & " months @ " & FormatCurrency(AmortPmnt) & _
" a month"
' Create a new recordset.
Set rsAmort = New ADODB.Recordset
With rsAmort
.Fields.Append "Principal Paid", adBSTR
.Fields.Append "Interest", adBSTR
.Fields.Append "Balance Due", adBSTR
.Fields.Append "Total Interest", adBSTR
.Open
End With
' Save the original loan amount to calculate the remaining principal.
tempBalance = LoanAmt ' Initialize temporary balance with original loan amount.
Interest = Interest / 1200
' For each month in the loan period...
For Count = 1 To Months
rsAmort.AddNew
' Calculate the interest paid for the current month.
tempInterest = Abs(IPmt(Interest, Count, Months, LoanAmt)) 'tempBalance * Interest / YearOrMonth
' Set value of the Interest field.
rsAmort!Interest = FormatCurrency(tempInterest)
' Calculate balance paid.
tempPaid = Abs(PPmt(Interest, Count, Months, LoanAmt)) 'AmortPmnt - tempInterest
' Set value of Principal Paid field.
rsAmort![Principal Paid] = FormatCurrency(tempPaid)
' set value of balance field.
rsAmort![Balance Due] = FormatCurrency(tempBalance - tempPaid)
' Calculate total interest paid
ttlInterest = ttlInterest + tempInterest
' set Total interest field
rsAmort![Total Interest] = FormatCurrency(ttlInterest)
' Calculate new balance.
tempBalance = tempBalance - tempPaid
Next Count
Set grdPayments.DataSource = rsAmort
' Add Row labels
grdPayments.Col = 0
For Count = 1 To Months
grdPayments.Row = Count
grdPayments.Text = "Month " & Count
Next Count
' Resize columns
Dim ttlWidth As Single
ttlWidth = grdPayments.Width - 800 ' To allow for scrollbar
For Count = 0 To grdPayments.Cols - 1
grdPayments.ColWidth(Count) = ttlWidth / 5
Next Count
' Disable cmdCalcAmort button
cmdCalcAmort.Enabled = False
AmortFlag = True
cmdPrint.Enabled = True
End Sub
Private Sub cmdCalcAmort_Click()
' Change the mouse pointer to an hourglass.
MousePointer = vbHourglass
' Calculate the amortization.
CalcAmort
' Return the mouse pointer to the default.
MousePointer = vbDefault
End Sub
Private Sub cmdCalcPmts_Click()
ValidateFields
CalculatePrincipal
' Change the mouse pointer to an hourglass.
MousePointer = 11
' Calculate the payments for all the loan lengths and interest RatesCnt.
CalcPmnts bYears
' Display payments in the grid.
Set grdPayments.DataSource = rsPayments
FormatGrid bYears
AmortFlag = False
cmdCalcAmort.Enabled = False
cmdPrint.Enabled = False
' Change the mouse pointer to the default.
MousePointer = 0
lblMessage.Caption = ""
End Sub
Private Sub ValidateFields()
' Disable the Show Amortization button.
cmdCalcAmort.Enabled = False
' Does the Purchase Amount have a value?
If txtPrice <= 0 Then
MsgBox "You must enter a valid purchase amount.", 48, "LoanSheet Error"
txtPrice.Text = ""
txtPrice.SetFocus
Exit Sub
End If
PurchAmt = txtPrice.Text
' Does Maximum Length of Loan have a value?
If txtIntMax.Text = "" Then
MsgBox "You must enter a maximum length of loan.", 48, "LoanSheet Error"
txtIntMax.SetFocus
Exit Sub
End If
' If the maximum loan length is less than the minimum loan length...
If txtIntMax.Text <> "" And LenMax < LenMin Then
MsgBox "Maximum length of loan must be greater than the minimum length of loan.", 48, "LoanSheet Error"
txtIntMax.Text = ""
txtIntMax.SetFocus
Exit Sub
End If
' If the minimum loan length has no value, set it equal to 1.
If txtLenMin.Text = "" Then
MsgBox "The minimum length of loan must be one month or year.", 48, "LoanSheet Error"
txtLenMin.Text = "1"
LenMin = 1
End If
' If the maximum interest rate is less than the minimum interest rate...
If IntrMax < IntrMin Then
MsgBox "Maximum interest rate must be greater than the minimum interest rate.", 48, "LoanSheet Error"
comIntrMax.SetFocus
Exit Sub
End If
' Is the maximum interest rate entered?
If IntrMax < 0.5 Then
MsgBox "You must specify a maximum interest rate greater than zero.", 48, "LoanSheet Error"
comIntrMax.SetFocus
Exit Sub
End If
' If no minimum rate is entered, the minimum rate = the maximum rate.
If IntrMin < 0.5 Then
comIntrMin.ListIndex = comIntrMax.ListIndex
IntrMin = IntrMax
End If
' Calculate the loan amount.
LoanAmt = PurchAmt * (1 - (DPAmt / 100))
End Sub
Private Sub FormatGrid(bTerms As Boolean)
' Format the grid with this procedure whenever
' you reset the DataGrid control's DataSource.
Dim i As Long
Dim strTempLabel As String
If bTerms Then
strTempLabel = " years"
Else
strTempLabel = " months"
End If
For i = 1 To grdPayments.Rows - 1
grdPayments.Row = i
grdPayments.Col = 0
grdPayments.Text = (i + LenMin - 1) & strTempLabel
Next i
grdPayments.ColWidth(0) = FixedColWidth
If grdPayments.Cols(0) <= 6 Then
For i = 1 To grdPayments.Cols(0) - 1
grdPayments.ColWidth(i) = (grdPayments.Width - FixedColWidth) / grdPayments.Cols(0)
grdPayments.ColAlignment(i) = flexAlignRightTop
Next i
Else
For i = 1 To grdPayments.Cols(0) - 1
grdPayments.ColWidth(i) = FixedColWidth
grdPayments.ColAlignment(i) = flexAlignRightTop
Next i
End If
End Sub
Private Sub CalculatePrincipal()
' Invoke this sub whenever you want the principal
' to be calculated. Calculate down payment, and
' subtract from price. Set form variables to the
' principal
txtDown.Text = Format(PurchAmt * DownPayRate, "Currency")
txtPrincipal.Text = Format(txtPrice - txtDown, "Currency")
DPAmt = PurchAmt * DownPayRate
LoanAmt = PurchAmt - DPAmt
End Sub
Private Sub comIntrMax_Click()
Validate comIntrMax, IntrMax
End Sub
Private Sub Validate(ctl As ComboBox, ByRef varX As Variant)
varX = Val(ctl.Text) ' varX is eiter intrMax or IntrMin
' If the maximum interest rate is less than the minimum interest rate...
If IntrMax < IntrMin Then
MsgBox "Maximum interest rate must be greater than or equal to the minimum interest rate.", 48, "LoanSheet Error"
comIntrMax.ListIndex = comIntrMin.ListIndex
comIntrMax.SetFocus
End If
End Sub
Private Sub comIntrMin_Click()
Validate comIntrMin, IntrMin
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
Private Sub frmLoanLen_DblClick()
' Click the Frame control to change the Terms
' from months to years and vice-versa.
If bYears Then
mnuMonths_Click
Else
mnuYears_Click
End If
End Sub
Private Sub grdPayments_Click()
' Only act if a cell contains a payment.
If grdPayments.Text <> "" And AmortFlag = False Then
' Enable the Show Amortization button.
cmdCalcAmort.Enabled = True
Else
' Disable the Show Amortization button.
cmdCalcAmort.Enabled = False
End If
End Sub
Private Sub grdPayments_DblClick()
' Only act if a cell contains a payment.
If grdPayments.Text <> "" And AmortFlag = False Then
' Enable the Show Amortization button.
cmdCalcAmort.Enabled = True
' Calculate the amortization.
grdPayments.MousePointer = vbHourglass
CalcAmort
grdPayments.MousePointer = vbDefault
' Change the mouse pointer to the default pointer.
Else
' Disable the Show Amortization button.
cmdCalcAmort.Enabled = False
End If
End Sub
Private Sub grdPayments_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyC And Shift = vbCtrlMask Then
If Clipboard.GetText <> "" Then
Clipboard.Clear
End If
Clipboard.SetText grdPayments.Text
End If
End Sub
Private Sub ChangeFont()
' Allow the end user to change the font size, name
' using the CommonDialog control.
With dlgFont
.Flags = cdlCFScreenFonts
.FontName = grdPayments.Font.Name
.FontSize = grdPayments.Font.Size
.FontBold = grdPayments.Font.Bold
.FontItalic = grdPayments.Font.Italic
.ShowFont
End With
With grdPayments
.Font.Name = dlgFont.FontName
.Font.Size = dlgFont.FontSize
.Font.Bold = dlgFont.FontBold
.Font.Italic = dlgFont.FontItalic
End With
End Sub
Private Sub mnuDlgFont_Click()
ChangeFont
End Sub
Private Sub mnuInstructions_Click()
' Declare local variables.
Dim MsgText As String
MsgText = "1 Enter the purchase amount, and percent down (down payment and principal are calculated for you."
MsgText = MsgText & vbCrLf & "2 Enter interest rates, and length range of loan."
MsgText = MsgText & vbCrLf & "3 Click the Calculate Payments button to display monthly payments in the grid."
MsgText = MsgText & vbCrLf & "4 Select a monthly payment and click the Show Amortization button to display an amortization schedule for the selected interest rate and length of loan in the grid."
MsgBox MsgText, , "LoanSheet Instructions"
End Sub
Private Sub mnuExit_Click()
Unload Me
End Sub
Private Sub mnuMonths_Click()
frmLoanLen.Caption = "Months"
mnuMonths.Checked = True
mnuYears.Checked = False
bYears = False
End Sub
Private Sub mnuYears_Click()
frmLoanLen.Caption = "Years"
mnuYears.Checked = True
mnuMonths.Checked = False
bYears = True
End Sub
Private Sub txtDown_GotFocus()
' This is a caculated field, so inform user
' of that, then set focus to the field they
' can set.
Dim strMess As String
strMess = "This number is calculated automatically "
strMess = strMess & "after you type in the percent field."
strMess = strMess & vbCrLf & "TIP: set percent down to 0 if you aren't putting money down."
MsgBox strMess
txtPercentDown.SetFocus
End Sub
Private Sub txtIntMax_GotFocus()
txtIntMax.SelStart = 0
txtIntMax.SelLength = Len(txtIntMax.Text)
End Sub
Private Sub txtIntMax_Validate(Cancel As Boolean)
If Val(txtIntMax.Text) > 1200 Or txtIntMax <= 0 Then
MsgBox "This must be a number larger than 0 and less than 1000."
txtIntMax.SelStart = 0
txtIntMax.SelLength = Len(txtIntMax)
txtIntMax.SetFocus
Cancel = True
Else
LenMax = Val(txtIntMax.Text)
End If
End Sub
Private Sub txtLenMin_GotFocus()
txtLenMin.SelStart = 0
txtLenMin.SelLength = Len(txtLenMin.Text)
End Sub
Private Sub txtLenMin_Validate(Cancel As Boolean)
If Val(txtLenMin.Text) > 999 Or txtLenMin <= 0 Then
MsgBox "This must be a number larger than 0 and less than 1000."
txtLenMin.SelStart = 0
txtLenMin.SelLength = Len(txtLenMin)
txtLenMin.SetFocus
Cancel = True
Else
LenMin = Val(txtLenMin.Text)
End If
End Sub
Private Sub txtPercentDown_GotFocus()
txtPercentDown.SelStart = 0
txtPercentDown.SelLength = Len(txtPercentDown)
End Sub
Private Sub txtPercentDown_Validate(Cancel As Boolean)
If Right(txtPercentDown, 1) = "%" Then
DownPayRate = Left(txtPercentDown, Len(txtPercentDown) - 1) / 100
Exit Sub
' If not, test if it's numeric.
Else
If IsNumeric(txtPercentDown) Then
Select Case TestNum(txtPercentDown)
Case True
Cancel = True
Exit Sub ' try again
Case False
DownPayRate = txtPercentDown
txtPercentDown = Format(DownPayRate, "percent")
CalculatePrincipal
Exit Sub
End Select
Else 'it's an unknown string
MsgBox "Please use a number between 0 and 1. Example: .2 = 20%"
txtPercentDown = 0.2
Cancel = True
txtPercentDown.SelStart = 0
txtPercentDown.SelLength = Len(txtPercentDown)
Exit Sub
End If
End If
CalculatePrincipal
End Sub
Private Function TestNum(x As Variant) As Boolean
' Test the percentage to make sure it's valid.
If x < 0 Or x > 0.99 Then
MsgBox "The number must be a decimal between 0 and 1. " & _
vbCrLf & "Example: 0.105 = 10.50%"
TestNum = True
txtPercentDown.SelStart = 0
txtPercentDown.SelLength = Len(txtPercentDown)
Else
TestNum = False
End If
End Function
Private Sub txtPrice_GotFocus()
' Select whole field.
txtPrice.SelStart = 0
txtPrice.SelLength = Len(txtPrice)
End Sub
Private Sub txtPrice_Validate(Cancel As Boolean)
' Validate by first checking if the value is numeric.
' If so then check that the value is not a negative
' number.
If Not IsNumeric(txtPrice) Then
Cancel = True
Exit Sub
End If
If txtPrice <= 0 Then
MsgBox "The purchase price must be greater than 0"
Cancel = True
Exit Sub
End If
' Set variable to the value.
PurchAmt = txtPrice.Text
' Reformat the value.
txtPrice = Format(PurchAmt, "Currency")
' The function calculates the principal.
CalculatePrincipal
End Sub
Private Sub txtPrincipal_GotFocus()
' This is a caculated field, so inform user
' of that, then set focus to the field they
' can set.
Dim strMess As String
strMess = "This number is calculated automatically "
strMess = strMess & "after you type in the percent field."
strMess = strMess & vbCrLf & "TIP: set percent down to 0 if you aren't putting money down."
MsgBox strMess
txtPercentDown.SetFocus
End Sub