1. Даны два числа a и b. Получить их сумму, разность и произведение.

Sub pr()

Dim a, b, s, p, r As Single

a = CSng(InputBox("Введите число"))

b = CSng(InputBox("Введите число"))

s = a + b

p = a * b

r = a - b

MsgBox s

MsgBox p

MsgBox r

End Sub

2. Даны действительные числа x и y. Получить (|x| – |y|) / (1 + |x·y|).

Sub pr()

Dim x, y, p As Single

x = CSng(InputBox("Введите число"))

y = CSng(InputBox("Введите число"))

p = (Abs(x) - Abs(y)) / (1 + Abs(x * y))

MsgBox p

End Sub

3. Даны два действительных положительных числа. Найти среднее арифметическое и среднее геометрическое этих чисел.

Sub pr()

Dim x, y, p, s As Single

x = CSng(InputBox("Введите число"))

y = CSng(InputBox("Введите число"))

s = (x + y) / 2

p = (x * y) / 2

MsgBox s

MsgBox p

End Sub

4. Даны катеты прямоугольного треугольника. Найти его гипотенуз.

Sub pr()

Dim x, y, p As Single

x = CSng(InputBox("Введите число"))

y = CSng(InputBox("Введите число"))

p = Sqr(x ^ 2 + y ^ 2)

MsgBox p

End Sub

5. Известна длина окружности. Найти площадь круга, ограниченного этой окружностью.

Sub pr()

Dim l, r, s As Single

l = CSng(InputBox("Введите число"))

r = l / 2 * 3.14

s = 2 * 3.14 * r ^ 2

MsgBox s

End Sub

6. Даны действительные числа x, y. Получить: max(x,y);

Sub pr()

Dim x, y As Single

x = CSng(InputBox("Введите число"))

y = CSng(InputBox("Введите число"))

If x > y Then

MsgBox x

End If

If y > x Then

MsgBox y

End If

End Sub

7. Даны действительные числа x, y. Получить: min(x,y);

Sub pr()

Dim x, y As Single

x = CSng(InputBox("Введите число"))

y = CSng(InputBox("Введите число"))

If x < y Then

MsgBox x

End If

If y < x Then

MsgBox y

End If

End Sub

8. Даны действительные числа a, b, c. Удвоить эти числа, если a > b > c, и заменить их абсолютными значениями, если это не так.

Sub pr()

Dim a, b, c As Single

a = CSng(InputBox("Введите число"))

b = CSng(InputBox("Введите число"))

c = CSng(InputBox("Введите число"))

If (a > c) And (b > c) Then

a = 2 * a

b = 2 * b

c = 2 * c

Else

a = Abs(a)

b = Abs(b)

c = Abs(c)

End If

MsgBox a

MsgBox b

MsgBox c

End Sub

9. Даны действительные числа x, y. Вычислить z:

Sub pr()

Dim x, y, z As Single

x = CSng(InputBox("Введите число"))

y = CSng(InputBox("Введите число"))

If x > y Then

z = x - y

Else

z = y - x + 1

End If

MsgBox z

End Sub

10. Даны два действительных числа. Вывести первое число, если оно больше второго, и оба числа, если это не так.

Sub pr()

Dim x, y, z As Single

x = CSng(InputBox("Введите число"))

y = CSng(InputBox("Введите число"))

If x > y Then

MsgBox x

Else

MsgBox x

MsgBox y

End If

End Sub

11. Написать макрос для нахождения суммы первых десяти чисел.

Sub pr()

Dim s, i As Integer

s = 0

For i = 1 To 10 Step 1

s = s + i

Next i

MsgBox s

End Sub

12. Найти сумму четных чисел в интервале от 20 до 100.

Sub pr()

Dim i, s As Integer

s = 0

For i = 20 To 100 Step 1

If i Mod 2 = 0 Then

s = s + i

End If

Next i

MsgBox s

End Sub

13. Найти сумму нечетных чисел в интервале от 30 до 200.

Sub pr()

Dim i, s As Integer

s = 0

For i = 30 To 200 Step 1

If i Mod 2 <> 0 Then

s = s + i

End If

Next i

MsgBox s

End Sub

14. Написать макрос для вычисления n!.

Sub pr()

Dim i, p, n As Integer

p = 1

n = CInt(InputBox("Введите число "))

For i = 1 To т Step 1

p = p * i

Next i

MsgBox s

End Sub

15. Дано натуральное n. Вычислить:

Sub pr()

Dim i As Integer

Dim f As Single

n = InputBox("Введите n")

f = 1

For i = 1 To n Step 1

f = f * (1 + 1 / i ^ 2)

Next i

MsgBox f

End Sub

16. Написать программу в результате выполнения которой подсчитывалась средняя температура за неделю.

Sub pr()

Dim m(6) As Single

Dim i As Integer

Dim s As Single

For i = 0 To 6 Step 1

m(i) = Val(InputBox("input znach"))

Next i

s = 0

For i = 0 To 6 Step 1

s = s + m(i)

Next i

s = s / 7

MsgBox s

End Sub

17. Дан массив из N элементов. Написать программу, выводящую на экран каждый второй элемент.

Sub pr()

Dim a() As Single

Dim i, n As Integer

n = InputBox("Введите количество элементов в массиве")

ReDim a(n)

For i = 0 To n Step 1

a(i) = InputBox("Введите элемент массива")

Next i

For i = 1 To n Step 2

MsgBox a(i)

Next i

End Sub

18. Написать программу, в результате выполнения которой подсчитывалась сумма элементов двухмерного массива размером 1 на 1.

Sub pr()

Dim m(1, 1) As Single

Dim i, j As Integer

Dim s As Single

For i = 0 To 1 Step 1

For j = 0 To 1 Step 1

m(i, j) = Val(InputBox("input znach"))

Next j

Next i

s = 0

For i = 0 To 1 Step 1

For j = 0 To 1 Step 1

s = s + m(i, j)

Next j

Next i

MsgBox s

End Sub

19. Дан массив размерностью 1 на 1. Найти сумму элементов находящихся на главной диагонали.

Sub pr()

Dim a(1, 1) As Single

Dim i, j As Integer

Dim s As Single

For i = 0 To 1 Step 1

For j = 0 To 1 Step 1

a(i, j) = InputBox("Введите элемент массива")

Next j

Next i

s = 0

For i = 0 To 1 Step 1

For j = 0 To 1 Step 1

If i = j Then

s = s + a(i, j)

End If

Next j

Next i

MsgBox s

End Sub

20. Дан одномерный массив. Найти сумму четных элементов массива.

Sub pr()

Dim a() As Single

Dim i, n, s As Integer

n = InputBox("Введите количество элементов в массиве")

ReDim a(n)

s = 0

For i = 0 To n Step 1

a(i) = InputBox("Введите элемент массива")

Next i

For i = 0 To n Step 1

If a(i) Mod 2 = 0 Then

s = s + a(i)

End If

Next i

MsgBox s

End Sub

21. Написать программу, в которую вводится массив записей о сотрудниках, а затем выводится информация об определенном сотруднике.

Type Sotr

fam As String

name As String

namber As String

adr As String

End Type

Sub pr()

Dim inf(1 To 10) As Sotr

Dim i, n, n1 As Integer

n = Val(InputBox("Введите количество сотрудников"))

For i = 1 To n Step 1

With inf(i)

.fam = InputBox("Введите фамилию")

.name = InputBox("Введите имя")

.namber = Val(InputBox("Введите номер телефона"))

.adr = InputBox("Введите адрес")

End With

Next i

n1 = Val(InputBox("Введите номер сотрудника"))

MsgBox inf(n1).fam & Chr(13) & _

Inf(n1).Name & Chr(13) & _

Inf(n1).Namber & Chr(13) & _

inf(n1).adr

End Sub

22. Написать программу телефонный справочник в котором можно находить информацию по фамилии абонента.

Type Abonent

fam As String

name As String

namber As String

adr As String

End Type

Sub pr()

Dim inf(1 To 10) As Abonent

Dim i, n As Integer

Dim n1 As String

n = Val(InputBox("Введите количество абонентов"))

For i = 1 To n Step 1

With inf(i)

.fam = InputBox("Введите фамилию")

.name = InputBox("Введите имя")

.namber = Val(InputBox("Введите номер телефона"))

.adr = InputBox("Введите адрес")

End With

Next i

n1 = InputBox("Введите фамилию абонента")

For i = 1 To n Step 1

If n1 = inf(i).fam Then

MsgBox inf(i).fam & Chr(13) & _

Inf(I).Name & Chr(13) & _

Inf(I).Namber & Chr(13) & _

inf(i).adr

End If

Next i

End Sub

23. Дано слово электродинамика. Получить слова: динамика, электрон, крона, трон, народ.

Sub pr()

Dim s, s1, s2, s3, s4, s5, s6, s7, s8 As String

s = InputBox("Введите строку")

s1 = Right(s, 8)

s2 = Left(s, 7)

s3 = Mid(s, 10, 1)

s4 = s2 & s3

s5 = Mid(s, 4, 1)

s6 = Mid(s, 6, 2)

s7 = Mid(s, 10, 2)

s8 = s5 & s6 & s7

MsgBox s1 & Chr(13) & _

s4 & Chr(13) & _

s8

End Sub

24. Вводится текст. Подсчитать количество определенных символов в этом тексте.

Sub pr()

Dim s, s1, s2, s3, s4, s5, s6, s7, s8 As String

Dim n, i, n1 As Integer

s = InputBox("Введите строку")

s1 = InputBox("Введите символ")

n = 0

n1 = Len(s)

For i = 1 To n1 Step 1

s2 = Mid(s, i, 1)

If s2 = s1 Then

n = n + 1

End If

Next i

MsgBox n

End Sub

25. Написать программу, в результате выполнения которой из двух текстовых файлов производилось бы чтение чисел, а затем эти числа складывались и записывались в третий файл.

Sub pr()

Dim str, str1 As String

Dim n, n1, n2 As Integer

Open "C:\1.txt" For Input As #1

Input #1, str

Close #1

n = Val(str)

Open "C:\2.txt" For Input As #2

Input #2, str1

Close #2

n1 = Val(str1)

n2 = n1 + n

Open "C:\3.txt" For Output As #3

Write #3, n2

Close #3

End Sub

26. Создайте пользовательскую форму на языке VBA, вычисляющую сложение трех чисел. Добавьте в форму кнопку Отмена для завершения работы с пользовательской формой.

код для кнопки Вычислить

Private Sub CommandButton1_Click()

Dim a, b, c, s As Single

a = CSng(UserForm1.TextBox1)

b = CSng(UserForm1.TextBox2)

c = CSng(UserForm1.TextBox3)

s = a + b + c

UserForm1.TextBox4 = s

End Sub

код для кнопки отмена

Private Sub CommandButton2_Click()

UserForm1.Hide

End Sub

27. 

код для кнопки Вычислить

Private Sub CommandButton1_Click()

Dim y, x As Single

x = CSng(UserForm1.TextBox1)

If x <= 0 Then

y = Sin(x)

Else

y = Cos(x)

End If

UserForm1.TextBox2 = y

End Sub

код для кнопки отмена

Private Sub CommandButton2_Click()

UserForm1.Hide

End Sub

28. Написать программу в результате выполнения которой вычислялось произведение или сложение двух чисел в зависимости от включенного переключателя.

Sub CommandButton1_Click()

Dim a, b, c As Single

a = CSng(TextBox1.Text)

b = CSng(TextBox2.Text)

If CheckBox1.Value = True Then

c = a + b

UserForm1.Label4 = c

End If

If CheckBox2.Value = True Then

c = a * b

UserForm1.Label4 = c

End If

If (CheckBox1.Value = False) And (CheckBox2.Value = False) Then

UserForm1.Label4 = "Ошибка. Не указана операция"

End If

End Sub

29. Написать макрос в результате выполнения которого создавалась бы таблица приведенная на рисунке, а курс доллара и количество долларов вводились бы в процессе выполнения макроса.

Sub Макрос1()

Range("A1").Select

ActiveCell = "Курс"

n = InputBox("Введите курс доллара")

Range("B1").Select

ActiveCell = n

Range("C1").Select

ActiveCell = "руб"

Range("A2").Select

ActiveCell = "Доллар"

Range("B2").Select

ActiveCell = "Рубль"

n1 = InputBox("Введите количество долларов")

Range("A3").Select

ActiveCell = n1

Range("B3").Select

ActiveCell.Formula = "=$b$1*a3"

End Sub

30. Написать макрос в результате, которого в тексте находилось бы слово «сформировать», а затем удалялось бы.

Sub primer()

With Selection.Find

.ClearFormatting 'поис без учета форматирования

.Text = "сформировать" 'отыскиваемый текст

.Execute 'выполнение поиска

If .Found = True Then 'если текст найден то удаление текста

Selection.Delete

End If

Selection.Find.Execute Replace:=wdReplaceAll 'применить ко всему тексту

End With

End Sub

31. Создать презентацию в которой есть управляющая кнопка. По нажатию этой кнопки вызывается форма при помощи которой можно учить пользователя производить вычитание чисел от 0 до 9.

Public Sub CommandButton1_Click()

Dim a, b, r, n As Integer

a = Int(10 * Rnd())

b = Int(10 * Rnd())

If a > b Then

Label1.Caption = a

Label3.Caption = b

Else

Label1.Caption = b

Label3.Caption = a

End If

End Sub

Public Sub CommandButton2_Click()

a = CInt(Label1.Caption)

b = CInt(Label3.Caption)

r = Abs(a - b)

n = CInt(TextBox1.Text)

If r = n Then

Label5.Caption = "Верно"

Else

Label5.Caption = "Ошибка"

End If

End Sub

32. Напишите макрос в результате выполнения которого открывался документ находящийся на диске С: с именем primer.doc. После этого в тексте первому предложению задавался шрифт 18 пунктов. Седьмой абзац выделялся курсивом и зеленым цветом. 15-му слову в тексте задавался шрифт жирный, курсив и подчеркнутый. После этого документ должен сохраняться и закрываться.

33. Напишите макрос в результате выполнения которого открывался документ, находящийся на диске D: с именем zadanie.doc. После этого в тексте первому предложению задавался шрифт 18 пунктов и красный цвет букв. Пятый абзац выделялся жирным. 7-му слову в тексте задавался шрифт жирный, курсив и подчеркнутый. После этого документ должен сохраняться и закрываться.

К задачам 32 – 33

Выделение второго абзаца в тексте:

Sub Макрос1()

ActiveDocument.Paragraphs(2).Range.Select

End Sub

Выделение второго слова в тексте:

Sub Макрос1()

ActiveDocument.Words(2).Select

End Sub

Выделение пятого предложения в тексте:

Sub Макрос1()

ActiveDocument.Sentences(5).Select

End Sub

Задание жирного шрифта выделенного фрагмента: Selection.Font.Bold = wdToggle

Задание курсива: Selection.Font.Italic = wdToggle

Задание подчеркнутого шрифта выделенного фрагмета: Selection.Font.Underline = wdUnderlineSingle

Изменение размера шрифта: Selection.Font.Size = 16

Изменение цвета шрифта: Selection.Font.Color = wdColorRed

Открытие документа.

Sub Макрос1()

Documents.Open FileName:="E:\primer.doc"

End Sub

Закрыть документ.

Sub Макрос1()

ActiveDocument.Close

End Sub

Сохранить докумет

Sub Макрос1()

ActiveDocument.SaveAs FileName:="e:\Doc3.docx"

End Sub

9