Примеры. Макросы в word.
‘ Пример 1 Макрос, обновляющий все поля при закрытии файла.
Sub Autoclose()
' Выделяем всё. Аналогично нажатию СTRL + A
Selection.WholeStory
'Обновляем всё, что выделено
Selection.Fields.Update
End Sub
Имя Autoclose()позволит макросу выполняться автоматически при закрытии документа.
‘ Пример 2 Иллюстрация «Если».Запрос о необходимости обновления полей в документе
Sub primer3()
'
' primer3 Макрос
' Макрос создан 03.12.05
' задали переменную а (целого типа)
Dim a As Integer
a = MsgBox("Обновить поля ?", vbOKCancel, "это мое окно сообщения")
'При нажатии на Ok функция возвратит 1 , в другом случае 0.
'Если а=1, то выделяем все и обновляем поля
If a = 1 Then
Selection.WholeStory
Selection.Fields.Update
End If
End Sub
‘ Пример 3 Иллюстрация использования окон ввода (диалога с пользователем)
Sub запрос()
'
' запрос Макрос
' Макрос создан 03.12.08
'
'
Dim a As Double
a = (InputBox("Введите курс доллара :", "Курс"))
' вызываем InputBox для получения курса доллара
' и присваеваем его переменной a
If a > 40 Then
MsgBox ("Не покупаем!!!")
Else MsgBox ("УРА, покупаем!!!")
End If
End Sub
‘ Пример 4 Создание простого диалогового окна 1
Задание:
Ввести число
По нажатию кнопки прибавить к нему число 10
Действия пользователя:
создаем форму
«ставим» на нее элементы: 2 Label, 2 TextBox, 1 CommandBotton
настраиваем работу кнопки CommandBotton (2 щелчка на ней → текст программы)
Private Sub CommandButton1_Click()
TextBox2 = TextBox1 + 10
End Sub
Создаем пустой макрос:
Load UserForm1
UserForm1.Show
Теперь можно запускать этот макрос из любого документа.
‘ Пример 5 Создание простого диалогового окна 2
Задание:
Ввести число
По нажатию кнопки, в зависимости от состояния флажка прибавить к нему число 10 или оставить данное число без изменений
Добавим на нашу форму флажок (Checkbox), он принимает всего 2 значения True/False, т.е:
включен -True
выключен -False
Можно это учесть в программе, изменив соответствующую строку на
If CheckBox1 = True Then
TextBox2 = TextBox1 + 10
Else
TextBox2 = TextBox1
End If
‘ Пример 6 вывод приветствия при запуске Word.
Sub AutoExec()
'
' Макрос4 Макрос
' Макрос создан 23.10.2008
' Сообщение должно содержать имя, задаваемое по вводу. В случае не введения имени вывести другое произвольное сообщение приветствия.
Dim name As String
name = InputBox("Введите ваше имя", "Приветствие")
If name <> "" Then
msgbox "Привет, " & name, vbInformation, "Приветствие"
Else
msgbox "Добрый день,незнакомец!" & name, vbOKOnly, "cообщение"
End If
End Sub
В
результате на экране будет
одно из сообщений:
Макросы в excel.
‘ Пример 1 увеличение значений в выделенных ячейках на константу
Sub Макрос1()
'
' Макрос1 Макрос
' Макрос записан 06.11.2008
Dim a, i, j, it, jt As Integer
'Зададим окно ввода (диалог с пользователем)
a = InputBox("const", "Vvedite const")
' вызываем InputBox для получения константы и присваиваем его переменной а.
'Jt И it –размер выделенной области
jt = Selection.Columns.Count
it = Selection.Rows.Count
'Изменение значений в ячейках
For i = 1 To it
For j = 1 To jt
'к выделенным ячейкам прибавляется значение равное а
Selection.Cells(i, j).Value = Selection.Cells(i, j).Value + a
Next j
Next i
End Sub
‘ Пример 2 В ячейку вводятся числа 1,2 или 3. Отобразить их значения прописью
Sub Макрос1()
'
' Макрос1 Макрос
' Макрос записан 06.11.2008
'
If (ActiveCell.FormulaR1C1 = "1") Then ActiveCell.FormulaR1C1 = "один"
If (ActiveCell.FormulaR1C1 = "2") Then ActiveCell.FormulaR1C1 = "два"
If (ActiveCell.FormulaR1C1 = "3") Then ActiveCell.FormulaR1C1 = "три"
End Sub
‘ Пример 3 Заполнение интервала ячеек случайными числами
Sub StickRandom()
Dim numRows As Integer, numCols As Integer
Dim theRow As Integer, theCol As Integer
'Определение размера текущего выбора.
numRows = Selection.Rows.Count
numCols = Selection.Columns.Count
Randomize
'Инициализация генератора случайных чисел
For theRow = 1 To numRows
For theCol = 1 To numCols
Selection.Cells(theRow, theCol).Value = Int(Rnd * 100)
Next theCol
Next theRow
End Sub
‘Пример 4 Вычисление среднего значения элементов массива
Sub BlockAverage()
Dim numRows As Integer, numCols As Integer
Dim theRow As Integer, theCol As Integer
Dim I As Integer, J As Integer
Dim theAverage As Single, theSum As Single
Dim myArray() As Single
'Определение размера текущего выбора.
numRows = Selection.Rows.Count
numCols = Selection.Columns.Count
ReDim myArray(numRows, numCols)
'Копирование содержимого ячеек в массив.
For theRow = 1 To numRows
For theCol = 1 To numCols
myArray(theRow, theCol) = Selection.Cells(theRow, theCol).Value
Next theCol
Next theRow
' Определение среднего арифметического элементов массива.
theSum = 0
For I = 1 To numRows
For J = 1 To numCols
theSum = theSum + myArray(I, J)
Next J
Next I
theAverage = theSum / (numRows * numCols)
MsgBox "Среднее арифметическое = " & Str(theAverage)
End Sub
‘ Пример 5 Расчет возраста в днях
Sub AgeCalculator()
Dim theReply As String, thePrompt As String
Dim theTitle As String, theDefault As String
Dim theAge As Single, OKFlag As Boolean
Dim theName As String
thePrompt = "Введите Ваше имя, пожалуйста."
theTitle = "Персональный информационный диалог"
theDefault = "Имя"
'Цикл ожидания ввода имени пользователя.
Do
theReply = InputBox(thePrompt, theTitle, theDefault)
If theReply = "" Then Exit Sub
'Нажата командная кнопка Cancel.
theReply = Trim(theReply)
'Удаление пробелов с двух сторон строки.
'Проверка на строку пробелов или пробел в строке.
If (theReply = "") Or (InStr(theReply, " ") <> 0) Then
MsgBox "Непонятно, попробуйте еще раз, пожалуйста.", , theTitle
OKFlag = False
ElseIf theReply = theDefault Then 'Пользователь просто нажал Enter
MsgBox "Напечатайте что-нибудь и попробуйте еще раз, пожалуйста."
OKFlag = False
Else
'Ввод завершен нормально.
theName = theReply
OKFlag = True
End If
Loop Until OKFlag
'Теперь получим имя пользователя.
thePrompt = "Здравствуйте, " & theReply & ". Введите Ваш возраст, пожалуйста."
'Цикл ожидания ввода корректного числа.
Do
theReply = InputBox(thePrompt, theTitle)
If theReply = "" Then Exit Sub
'Нажата командная кнопка Cancel.
theAge = Val(theReply)
'Преобразование строки в число.
If Not IsNumeric(theReply) Then
'Введено не число.
MsgBox "Введите число и попробуйте еще раз, пожалуйста.", , theTitle
OKFlag = False
'Проверка корректности введенного числа.
ElseIf (theAge < 1) Or (theAge > 120) Then
MsgBox "Не верится, чтобы Вам было " & Str(theAge) & _
"лет. Попробуйте еще раз, пожалуйста.", , theTitle
OKFlag = False
Else
'Похоже на возраст.
OKFlag = True
End If
Loop Until OKFlag
'Расчет приблизительного возраста в днях.
MsgBox "Вам приблизительно " & Format(theAge * 365, "#,###") & " дней.", , theTitle
End Sub
‘Пример 6 Сложение 2-х вводимых чисел
Sub prim4()
a = InputBox("введите а", "ввод данных", 1)
b = InputBox("введите в", "ввод данных", 2)
c = Val(a) + Val(b)
MsgBox c
End Sub
‘Пример 7 Вычисление квадрата чисел от 1 до 10
Sub prim5()
For I = 1 To 10 Step 1
n = I * I
MsgBox "I = " & Str(I) & " n = " & Str(n)
Next I
End Sub
Сидоров В.В., Перепухова И.Г.