Для решения задачи нахождения вычисления амортизации оборудования по стандартному методу или методу к -кратного учета с помощью редактора пользовательских форм создадим диалоговое окно Расчет амортизации (рис. У4.1).
Рис. У4.1. Диалоговое окно Расчет амортизации
Обсудим, как приведенная ниже программа решает перечисленные задачи и что происходит в программе.
UserForm Initialize |
| ||
|
|
Рис. У4.2. Диалоговое окно Расчет амортизации при выбранном переключателе Метод k кратного учета
SpinButton1_ Change | Изменяет значение счетчика, которое вводится в i поле Кратность метода. | ||
OptionButton2_Click | Отображает в диалоговом окне надпись кратность; метода и соответствующие ей поле и счетчик. | ||
OptionButton2_Click | Скрывает в диалоговом окне надпись кратность метода и соответствующие ей поле и счетчик. | ||
Нажатие кнопки вычислить запускает на выполнение процедуру CoramandButton1_Click |
| ||
а)
б)
Рис. У4.3. Сообщения о несогласованности вводимых данных
Рис. У4.4. Отчет, выводимый на рабочем листе программой расчета амортизации
Нажатие кнопки отмена запускает на выполнение процедуру CommandButton2_Click | Закрывает диалоговое окно. | ||
Private Sub CommandButton1_Click()
|
|
' Процедура расчета амортизации
'
Dim В As Double
Dim E As Double
Dim A As Double
Dim Ye As Integer
Dim Yc As Integer
Dim k As Integer
Dim Flag As Boolean
'
' В - первоначальная стоимость оборудования, для которого
' подсчитывается амортизация
' Е - остаточная стоимость оборудования
' Ye - время полной „амортизации
' Yc - период, для которого рассчитывается амортизация
' Flag - логическая переменная, равная True, если амортизация
' рассчитывается стандартным методом, и False, если методом
' k-кратного учета
Dim n As Integer
Dim j As Integer
' n, j - вспомогательные переменные, используемые для удаления
' ранее созданных графических объектов
'
' Считывание в переменные из диалогового окна значений параметров
В = CDbl(TextBox1.Text)
Е = CDbl(TextBox2.Text)
Ye = CInt(TextBox3.Text)
Yc = CInt(TextBox4.Text)
' Проверка согласованности вводимых данных
'
If В < Е Then
MsgBox "Остаток больше начальной стоимости", vbExclamation, "Амортизация"
TextBox1.SetFocus
Exit Sub
End If
If Ye < Yc Then
MsgBox "Ошибка в сроке амортизации", vbExclamation, "Амортизация"
TextBox3.SetFocus
Exit Sub
End If
'
' Определение выбранного переключателя:
' если Стандартный, то переменной Flag присваивается True;
' если k-кратного учета, то переменной Flag присваивается False
'
If OptionButton1.Value = True Then
Flag = True
Else
Flag = False
End If
' Расчет амортизации в зависимости от выбранного метода
'
If Flag = True Then
'
' Стандартным методом
A = Application.SYD(В, Е, Ye, Yc)
Else
' Методом k-кратного учета
'
k = CInt(TextBox6.Text)
A = Application.DDB(B, E, Ye, Yc, k)
End If
' Вывод величины амортизации в диалоговом окне
'
If A >= 0.01 Then
A = Format(A, "Fixed")
Else
A = 0
End If
TextBoxS.Text = CStr(A)
'
' Подготовка рабочего листа для ввода данных
'
'
' Определения общего числа объектов Shape на рабочем листе
'
n = ActiveSheet.Shapes.Count
'
' Удаление с рабочего листа всех ранее созданных объектов Shape
'
If n >= 1 Then
For j = 1 To n
ActiveSheet.Shapes(j).Select Selection.Delete
Next j
End If
'
' Создание объекта WordArt
'
ActiveSheet.Shapes.AddTextEffeet(msoTextEffect14, "Амортизация",
"Impact", 18#, msoTrue, msoFalse, 166.5, 105#).Select
'
' Сдвиг объекта WordArt
'
Selection.ShapeRange.IncrementLeft 111# Selection.ShapeRange.IncrementTop -100.5
' Изменение ширины столбцов А и В и установка в
' них режима ввода текста с переносом
ActiveSheet.Columns("A").Select
With Selection
.ColuranWidth = 30
.WrapText = True
End With
ActiveSheet.Columns("B")
.Select With Selection
.ColumnWidth = 20.WrapText = True
End With
' Снятие выделения со столбца В выбором одной ячейки
'
ActiveSheet.Range("Bl").Select
' Ввод заголовков полей на рабочем листе
'
With ActiveSheet
.Range (."Al").Value = "Начальная стоимость"
.Range("A2").Value = "Остаточная стоимость"
.Range("A3").Value = "Время полной амортизации"
.Range("A4").Value = "Период, для которого рассчитывается амортизация"
.Range("A5").Value = "Расчет выполнен"
.Range("A6").Value = "Величина амортизации"
End With
'
'
' Ввод данных в ячейки рабочего листа
'
With ActiveSheet
.RangeC"B1").Value = В
.Range("B2").Value = Е
.Range("ВЗ").Value = Ye
.Range("B4").Value = Yc
.Range("B6").Value = A
.Range("B5").WrapText = True
If Flag = True Then
.Range("B5").Value = "стандартным методом"
Else
.Range("B5").Value = "методом " & CStr(k) &
" кратного учета амортизации"
End If
End With
End Sub
'
Private Sub CommandButton2_Click ()
'
' Процедура закрытия диалогового окна
'
UserForm1.Hide End Sub
Private Sub OptionButton1__Click()
'
' Процедура скрывает название, поле и счетчик для ввода
' кратности амортизации
'
Label6.Visible = False
TextBox6.Visible = False
SpinButton1.Visible = False
End Sub
Private Sub OptionButton2_Click()
'
' Процедура делает видимыми название, поле для ввода
' кратности амортизации и счетчик
Label6.Visible = True
TextBox6.Visible = True
SpinButton1.Visible = True
End Sub
Private Sub SpinButton1_Change()
' Процедура вводит значение счетчика в поле ввода
'
TextBox6.Text = CStr(SpinButton1.Value)
End Sub
Private Sub UserFormJEnitialize()
'
' Процедура активизирует диалоговое окно Расчет амортизации
'
' При инициализации окна выбран первый переключатель
OptionButton1.Value = True
'
' Первоначально название, поле и счетчик для ввода
|
|
' кратности амортизации не отображаются в диалоговом окне i
TextBoxS.Enabled = False
TextBox6.Visible = False
Label6.Visible = False
SpinButton1.Visible = False
'
' Минимальное значение и шаг,
' с которым изменяются значения счетчика
'
With SpinButton1.Min = 2.SmallChange = 2
End With
'
' Функция кнопки Отмена выполняется по умолчанию
'
CommandButton2.Default = True
'
' Нажатие.клавиши <Esc> эквивалентно нажатию кнопки Отмена
CommandButton2.Cancel = True
'
' Функция кнопки Вычислить выполняется по нажатию клавиш <Alt>+<D>
' или на русской клавиатуре <Alt>+<B>
'
CommandButton1.Accelerator = "D" '
' Функция кнопки Отмена выполняется по нажатию клавиш <Alt>+<J>
' или на русской клавиатуре <Alt>+<0>
CommandButton2.Accelerator = "J"
UserForm1.Show
'
End Sub
При написании программ с внедренными графическими объектами лучше всего воспользоваться средством MacroRecorder.
Итак, для активизации MacroRecorder выберите команду Сервис, Макрос, Начать запись (Tools, Macro, Record New Macro) и запустите MacroRecorder на запись. После задания всех параметров в появившемся диалоговом окне Запись макроса (Record Macro) и нажатия кнопки ОК появится плавающая панель инструментов с кнопкой Остановить запись (Stop Recording). Теперь все производимые действия будут записываться до тех пор, пока не будет нажата эта кнопка. Выполните построение объекта WordArt по следующему алгоритму:
- Нажмите кнопку Добавить объект WordArt (Insert WordArt) панели инструментов Рисование (Drawing).
- В появившемся окне Коллекция WordArt (WordArt Gallery) выберите нужный стиль надписи. Нажмите кнопку ОК.
- В появившемся окне Изменение текста WordArt (Edit WordArt Text) установите шрифт и размер отображаемого текста, а также в поле Текст (Text) введите текст, который будет отображаться, например Амортизация. Нажмите кнопку ОК.
- На рабочем листе появится внедренный объект WordArt. Выберите и перенесите его в требуемое место на этом листе.
- Для того чтобы разобраться, как происходит программное удаление объекта WordArt с рабочего листа, выделите его и удалите с помощью клавиши <Delete>.
Перечисленные выше действия будут переведены MacroRecorder в следующий макрос.
Sub Макрос1()
' Макрос1 Макрос
' Макрос записан 26.04.99 (Андрей)
|
|
'
ActiveSheet.Shapes.AddTextEffeet(msoTextEffect!4,
"Амортизация", "Impact",
18#, msoTrue, msoFalse, 166.5, 105#).Select
Selection.ShapeRange.IncrementLeft lilt
Selection.ShapeRange.IncrementTop -100.5
ActiveSheet.Shapes("WordArt 1").Select
Selection.Delete
End Sub
Первые три инструкции этого макроса предназначены для создания объекта wordArt. Их просто надо скопировать в то место программы расчета амортизации, где создается этот объект. Две последние инструкции связаны с удалением объектов wordArt с рабочего листа. Подсказка со стороны MacroRecorder очень полезна, т. к. у объекта wordArt нет метода Delete. Удаляемый объект необходимо выбрать, что приведет к образованию объекта selection. Удалять надо не непосредственно объект wordArt, а полученный указанным способом объект Selection. Эта идея как раз и реализована в данном приложении.