- •266Лекция 13. Язык программирования Visual Basic for Application (vba)
- •Лекция 13. Язык программирования Visual Basic for Application (vba)
- •Типы данных
- •Инструкции vba
- •Имена vba
- •Процедуры vba
- •Подпрограмма Sub
- •Функция Function
- •Функции ввода-вывода данных и сообщений
- •Функция MsgBox
- •Функция InputBox
- •Управляющие конструкции vba
- •Проверка условия — If
- •Select Case
- •For Next
- •While…Wend
- •Do …Loop
- •Функции пользователя
- •Макросы Microsoft Office
- •Макросы Word
- •Макросы Excel
- •Макросы Access
- •Контрольные вопросы
While…Wend
Выполняется проверка условия, если условие истинно, выполняются операторы тела цикла. Это так называемый цикл с предусловием, выход из цикла должен быть предусмотрен в теле цикла.
While условие продолжения цикла
операторы тела цикла
Wend
Пример 13
Вводится ставка налога и облагаемая налогом сумма. Если рассчитанная сумма налога удовлетворяет, выйти с помощью кнопки ОК.
Фрагмент программного кода:
i = InputBox("Введите ставку налога 0,12-0,25", _
, 0.12)
While sale > 0
sale = InputBox("Введите начальную сумму", _
, 1000)
sale = sale * (1 - i)
If MsgBox("Остаточная сумма после ” & _
"вычета налога - " & sale, vbOKCancel) = _
vbOK Then GoTo Ext
Wend
Ext: MsgBox "Конец расчета", vbInformation
Do …Loop
Циклическое выполнение операторов, имеет различные способы задания.
Вариант 1. Предварительная проверка условия до начала выполнения тела цикла. В теле цикла изменяется условия продолжения цикла. Если условие ложно, при очередной проверке управление передается следующей за Loop инструкции. Принудительный выход из цикла — инструкция Exit Do.
Do While <условие продолжения цикла>
тело цикла
Loop
Пример 14
Задать количество повторений цикла ввода. Если вводимое число больше 1000, обработку прекратить.
Фрагмент программного кода:
ff = CDec(InputBox("Число повторений цикла", , 5))
‘ функция CDEC преобразует строку в число
Do While ff >=0
ff = ff - 1
If CDec(InputBox("Введите любое число," & _
"меньше 1000", , 1000)) >= 1000 Then
Exit Do
End If
Loop
Вариант 2. Задается условие прекращения цикла. Если условие истинно, цикл не выполняется, управление передается инструкции, следующей за Loop.
Do Until <условие прекращения цикла>
тело цикла
Loop
Пример 15
Фрагмент программного кода:
ff = CDec(InputBox("Число повторений цикла", , 5))
Do Until ff < 0
ff = ff - 1
If CDec(InputBox("Введите любое число, " & _
"меньше 1000", , 1000)) >= 1000 Then
Exit Do
End If
Loop
Вариант 3. Для первого выполнения цикла условие не проверяется. В теле цикла выполняется изменение условия продолжения цикла. Цикл продолжается, пока условие истинно. Если условие ложно, управление передается инструкции, следующей за Loop While. Принудительный выход из тела цикла выполняется с помощью инструкции Exit Do:
Do
тело цикла
Loop While <условие продолжения цикла>
Пример 16
Фрагмент программного кода:
ff = CDec(InputBox("Число повторений цикла", , 5))
Do
ff = ff - 1
If CDec(InputBox("Введите любое число, " & _
"меньше 1000", , 1000)) >= 1000 Then
Exit Do
End If
Loop While ff > 0
Вариант 4. Для первого выполнения цикла условие не проверяется. В теле цикла выполняется изменение условия. Цикл продолжается, пока условие истинно. Если условие ложно, управление передается инструкции, следующей за Loop While. Принудительный выход из тела цикла выполняется с помощью инструкции Exit Do:
Do
тело цикла
Loop Until <условие прекращения цикла>
Пример 17
Фрагмент программного кода:
ff = CDec(InputBox("Число повторений цикла", , 5))
Do
ff = ff - 1
If CDec(InputBox("Введите любое число, " & _
"меньшее 1000", , 1000)) >= 1000 Then
Exit Do
End If
Loop Until ff <= 0
Пример 18
Создать процедуру, которая вызывает процедуры:
подачи звукового сигнала определенного тона;
вывода сообщения;
сохранения документа в папке с указанным именем.
Option Explicit
Sub Main() ‘Главная процедура
MultiBeep 56 ‘Вызов MultiBeep с 1 параметром
Message ‘Вызов Message без параметра
SaveDoc "c:\Metod", "Ex1.doc"
‘Вызов SaveDoc с 2 параметрами
End Sub
‘**********************************
Sub MultiBeep(bps)
Dim i As Integer
For i = 1 To bps
Beep
Next i
End Sub
‘**********************************
Sub Message()
MsgBox "Сохраните документ!"
End Sub
‘**********************************
Sub SaveDoc(dr As String, fl As String)
‘Параметры — имена папки и файла
Dim all As String
If Dir(dr) <> "" Then ‘Проверка наличия папки
all = dr & "\" & fl
‘сохранить активный документ
ActiveDocument.SaveAs FileName:=all, _
FileFormat:=wdFormatDocument
Else
MsgBox "Папки нет, файл не сохранен"
End If
End Sub
Пример 19
Создать функцию вычисления наращенной суммы, размещаемой на депозитном счете на заданный срок под определенный годовой процент с условием дополнительных вложений.
Формула для вычисления:
pmt – фиксированная сумма ежегодного взноса;
r – годовая процентная ставка;
n – срок;
type - тип выплат: 1 - в начале, 0 - в конце учетного периода;
pv – начальный капитал;
fv – наращенная сумма.
Public Function FVAL(pv As Single, nr As Single, _
pmt As Single, kper As Byte) As Single
If nr / 100 > 1 Then
MsgBox "Таких годовых процентов, как " _
& CStr(nr) & " не бывает"
Exit Function
Else
FVAL = pv * (1 + nr / 100) ^ kper + _
pmt * (1 + nr / 100) ^ kper / nr / 100
End If
End Function
‘**********************************************
Public Sub Bank()
Dim ppv As Single, pnr As Single, ppmt As Single, pkper As Byte
ppv = InputBox("Начальный капитал - ")
pnr = InputBox("Годовой процент - как целое число")
ppmt = InputBox("Ежегодный взнос - ")
pkper = InputBox("Срок размещения - ")
MsgBox "На первоначальный капитал - " & ppv & _
"руб. под " & pnr & " % годовых " & _
" и ежегодном взносе - " & ppmt & _
" руб. в течение - " & pkper & _
" лет Вы заработаете - " & _ CStr(Round(FVAL(CSng(ppv), CSng(pnr), _
CSng(ppmt), CByte(pkper)), 2)) & _
" руб.", vbInformation, _
"Результат финансовой функции"
End Sub