Практика
В данном приложении решается задача нахождения размера постоянных платежей по выданной в долг сумме на фиксированный срок под фиксированные проценты. Приложение рассчитывает размер выплат для различных процентных ставок, изменяющихся от начальной до конечной с указанным шагом.
Рис. У9.1. Диалоговое окно Периодических выплат
Кроме того, приложение строит диаграмму, показывающую зависимость величины выплат от процентной ставки. Тип диаграммы можно задать, выбирая переключатель из группы диаграмма диалогового окна Периодических выплат (рис. У9.1). Результат табуляции зависимости размера выплат от процентной ставки выводится в элемент управления ListBox диалогового окна и на рабочий лист (рис. У9.2).
Рис. У9.2. Отчет, создаваемый приложением на рабочем листе
Обсудим, как приведенная ниже программа решает описанную задачу и что в ней происходит.
| UserForm Initialize |
| ||||
| Нажатие кнопки Вычислить запускает на выполнение процедуру CommandButtonl_Click |
| ||||
Рис. У9.3. Пример сообщения о несогласованности данных
OptionButton1_Click, OptionButton2_Click и OptionButton3_Click |
Выбирает переключатель гистограмма, график или Круговая группы Диаграмма. Проверяет наличие на диске файла, отображаемого в элементе управления image при данном выборе переключателя. Если такого файла нет, то информирует об этом пользователя, и программа продолжает свою работу без загрузки отсутствующего файла. Если файл имеется, то изображение, содержащееся в этом файле, выводится в элементе управления Image . |
||
График |
Удаляет с рабочего листа все ранее построенные диаграммы. Строит диаграмму на рабочем листе. Аргументами процедуры являются ТипГрафика и его Формат. |
||
' Процедура вычисления выплат по ссуде
Dim p As Double
Dim i_нпc As Double
Dim i кпс As Double
Dim i_шar As Double
Dim k As Integer
Dim i As Integer
Dim n As Integer
Dim m As Integer
Dim A()As Double
Dim Проценты() As Double
Dim ПроцентыФормат() As Variant
Dim ЭлементыСписка() As Variant
Dim Area As Object
'
' i_нпс - начальная процентная ставка
' i_кnc - конечная процентная ставка
' i_inar - шаг процентной ставки
' р - ссуда
' k - число выплат
'А() - динамический массив значений выплат
' Проценты() - динамический массив значений процентных ставок
' ПроцентыФормат() - динамический массив значений процентных ставок,
' отформатированных по процентному формату
' ЭлементыСписка() - динамический массив, состоящий из двух столбцов:
' значений процентных ставок и выплат, выводимых в список
'
' Проверка: вводятся ли в поля диалогового окна числа
'
If IsNumeric(TextBoxl.Text) = False Then
MsgBox "Ошибка в ссуде", vbInformation, "Выплаты" TextBox1.SetFocus
Exit Sub
End If
If IsNumeric(TextBox2.Text) = False Then
MsgBox "Ошибка в числе выплат", vblnformation, "Выплаты"
TextBox2.SetFocus
Exit Sub
End If
If IsNumeric(TextBox3.Text) = False Then
MsgBox "Ошибка в начальной процентной ставке", vblnformation, "Выплаты"
TextBox3.SetFocus
Exit Sub
End If
If IsNumeric(TextBox4.Text) = False Then
MsgBox "Ошибка в конечной процентной ставке", vblnformation, "Выплаты"
TextBox4.SetFocus
Exit Sub
End If
If IsNumeric(TextBoxS.Text) = False Then
MsgBox "Ошибка в шаге процентной ставки", vblnformation, "Выплаты"
TextBox5.SetFocus
Exit Sub
End If
'
' Присвоение переменным значений, вводимых в диалоговом окне
'
р = CDbl(TextBoxl.Text)
k = CInt(TextBox2.Text)
i_нпс = CDbl(TextBox3.Text) / 100
i_Knc = CDbl(TextBox4.Text) / 100
i_шar = CDbl(TextBox5.Text) / 100
'
' Проверка согласованности вводимых процентных ставок.
' Несогласованность ввода отображается в сообщении
'
If i_кпс < i_нпс Then
MsgBox "Конечная процентная ставка меньше начальной",
vbExclamation, "График" TextBox3.SetFocus
Exit Sub End If If i_кпс < i_нпс + i_шar Then
MsgBox "Шаг слишком большой!" & Chr(13) &
"Табулируется только одно значение.", vbExclamation, "График" TextBox5.SetFocus
Exit Sub
End If
If i_шar <= 0 Then
MsgBox "Шаг должен быть положительным!",
vbExclamation, "График" TextBox5.SetFocus
Exit Sub
End If
'
' Очистка рабочего листа от результатов предыдущих вычислений '
ActiveSheet.Cells.Clear
' m - количество процентных ставок
'
m = (i_кпс - i_нпс) / i_шаг + 1
'
' Установка границ динамических массивов Проценты,
' ПроцентыФормат и А
ReDim А(1 Тo m)
ReDim Проценты(1 То m)
ReDim ПроцентыФормат(1 То m)
'
' Ввод заголовков записей на рабочий лист
With ActiveSheet
.Range("A:A").ColumnWidth =17.6
.Range("Al").Value = "Процентная ставка"
.Range("A2").Value = "Размер выплаты"
.Range("A3").Value = "Ссуда"
.Range("A4").Value = "Число выплат"
End With
' Форматирование заголовков записей
'
ActiveSheet. Range ("Al: A4 ")
.Select With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = x1Bottom
.WrapText = False
.Orientation = 30
.ShrinkToFit = False
.MergeCells = False
End With
With Selection.Interior
.CqlorIndex =36
.Pattern = xlSolid
.PatternColorlndex = xlAutomatic
End With
'
' Вывод данных на- рабочем листе
'
With ActiveSheet
For i = 1 To m
Проценты(i) = i_нпс + i_шar * (i - 1) A(i) = Application.Pmt(Проценты(i), k, -p) A(i) = Format(A(i), "##")
ПроцентыФормат(i) = Format (ПроцентыЦ) , "#.0%")
.Cells(1, i + 1}.Value = ПроцентыФормат(i)
.Cells(2, i + 1).Value = A(i)
Next i
.Range("B3").Value = p
.Range("B4").Value = k
End With
'
' Установка границ динамического массива ЭлементыСписка
' Используется для вывода значений процентных ставок
' и значений соответствующих выплат в список
'
ReDim ЭлементыСписка(i To m, 0 To 1)
'
' Поэлементное определение массива ЭлементыСписка
For i = 1 То m
ЭлементыСписка(i, 0) = ПроцентыФормат(i)
ЭлементыСписка(i, 1) = A(i)
Next i
' Заполнение списка с двумя колонками данных
'
With ListBoxl .Clear
.ColumnCount = 2
.List = ЭлементыСписка()
.Listlndex = 0
End With '
' Удаление всех графических объектов с активного рабочего листа
'
ActiveSheet.ChartObjects.Delete
'
' Определение выбранного переключателя,
' задающего тип диаграммы и
' построение выбранной диаграммы
'
If OptionButtonl.Value = True Then График xlColumn, 6
If OptionButton2.Value = True Then График xlLine, 10
If OptionButton3.Value = True Then График xlPie, 7
'
End Sub
'
Sub График(ТипГрафика As Integer, Формат As Integer)
'
' Процедура построения графика
' ТипГрафика - определяет тип диаграммы на втором шаге мастера диаграмм
' Формат - определяет вид диаграммы на третьем шаге мастера диаграмм
Dim Area As Object
Dim n As Integer
'
' Объектная переменная Area - диапазон, по которому строится диаграмма
Set Area = ActiveSheet.Cells(1, 2).CurrentRegion
'
' n - число столбцов диапазона Area
'
'
n = Area.Columns.Count
' (195, 30, 200, 190) - координаты области, где строится диаграмма
ActiveSheet.ChartObjects.Add(195, 30, 200, 190).Select
' Построение диаграммы
'
ActiveChart.ChartWizard Source:=
Range(Cells(1, 2), Cells(2, n)),
Gallery:=ТипГрафика, Format:=Формат,
PlotBy:=xlRows, CategoryLabels:=l,
SeriesLabels:=0, HasLegend:=False,
Title:="Диаграмма", CategoryTitle:="Cтaвкa",
ValueTitle:="Выплаты", ExtraTitle:=""
'
End Sub '
Private Sub CommandButton2_Click()
' Процедура закрытия диалогового окна
'
UserForml.Hide End Sub
Private Sub CommandButton3_Click()
' Процедура очистки рабочего листа
'
ActiveSheet.ChartObjects.Delete
'
' Очистка ячеек рабочего листа
ActiveSheet.Cells(1,1).CurrentRegion.Clear
End Sub '
Private Sub OptionButtonl_Click()
' Процедура загрузки файла в элемент управления Image
' при выборе переключателя Гистограмма
'
On Error
GoTo Сообщение1
Imagel.Picture = LoadPicture("VBA3_F1.BMP")
Exit Sub
'
' В случае отсутствия файла с рисунком отображается сообщение
'
Сообщение1:
If Err.Number = 52 Then
MsgBox "Нет графического файла VBA3_F1.BMP." & Chr'(13) &
"Работаем без картинки", vbCritical, "Выплаты"
End If
Resume Next
End Sub
Private Sub OptionButton2_Click()
'
' Процедура загрузки .файла в элемент управления Image
' при выборе переключателя График
On Error GoTo Сообщение2
'
Imagel.Picture = LoadPicture("VBA3_F2.BMP")
Exit Sub
'
' В случае отсутствия файла с рисунком отображается сообщение
'
Сообщение2:
If Err.Number = 52 Then
MsgBox "Нет графического файла VBA3_F2.BMP." & Chr(13) &
"Работаем без картинки", vbCritical, "Выплаты"
End If
Resume Next '
End Sub
'
Private Sub OptionButton3_Click()
' Процедура загрузки файла в элемент управления Image
' при выборе переключателя Круговая
On Error GoTo СообщениеЗ
'
Imagel.Picture = LoadPicture("VBA3_F3.BMP")
' В случае отсутствия файла с рисунком отображается сообщение
Exit Sub
Сообщение3:
If Err.Number = 52 Then
MsgBox "Нет графического файла VBA3_F3.BMP." & Chr(13) &
"Работаем без картинки", vbCritical, "Выплаты"
End If
Resume Next
'
End Sub
Private Sub UserForm_Initialize()
'
' Процедура инициализации и активизации диалогового окна
'
'
' Первоначальный выбор переключателя Гистограмма
'
OptionButtonl.Value = True
' Назначение клавише <Enter> функции кнопки Вычислить
'
With CommandButtonl
.Default = True
.ControlTipText = "Вьмисления и составление отчета на рабочем листе"
End With
With CommandButton2
.Cancel = True
.ControlTipText = "Кнопка отмены"
End with
CommandButton3.
.ControlTipText = "Очистка рабочего листа"
' '
On Error
GoTo Сообщение0
With Image1
' Установка такого же цвета границы элемента управления Image,
' как и его фон
'
.BorderColor = .BackColor '
' Загрузка рисунка соответствующего переключателю Гистограмма
'
.Picture = LoadPicture("VBA3_F1.BMP")
End With
'
UserForml.Show
Exit Sub '
' В случае отсутствия файла с рисунком, отображается сообщение
'
Сообщение0:
If Err.Number = 52 Then
MsgBox "Нет графического файла VBA3_F1.BMP." & Chr(13) &
"Работаем без картинки", vbCritical, "Выплаты"
End If
Resume Next
End Sub
При разработке данного приложения может возникнуть только одно затруднение: Откуда взять подходящие картинки, отображаемые в группе диаграмма диалогового окна Периодических выплат?
Но, к счастью, это только кажущаяся, можно сказать виртуальная, загвоздка. Эти картинки присутствуют в диалоговом окне первого шага мастера диаграмм. Таким образом, задача сводится к простому экстрагированию их оттуда. Для этого достаточно:
