Запись макроса в MS Excel

Размещено на http://www.allbest.ru/

Задание 1

С помощью макрорекордера записать макрос в MS Excel. Назначить горячие клавиши для выполнения макроса.

Создать кнопку панели инструментов для выполнения макроса.

Вариант	Задание
1	Макрос, центрирующий содержимое ячейки по вертикали и горизонтали

Выбираем меню Сервис > Макрос > Начать запись.

Выполняем центрирование содержимого активной ячейки (ПКМ > Формат ячеек > вкладка Выравнивание).

Останавливаем запись.

Запускаем редактор VBA (Alt+F11), получаем готовый код.

Sub Макрос1()

' Макрос1 Макрос

' Макрос записан 13.05.2011

' Сочетание клавиш: Ctrl+м

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlCenter

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

End Sub

Выбираем меню Сервис > Настройка, вкладка Команды, Категория Макросы, команда Настраиваемая кнопка, перетаскивем ее на панель инструментов.

Диалоговое окно Настройка НЕ ЗАКРЫВАЕМ, щелкаем по созданной кнопке ПКЛ (правой клавишей мыши), выбираем из контекстного меню Назначить макрос

Рисунок 1 - Назначение макроса кнопке

Задание 2

Создать функции пользователя. На рабочем листе создать таблицы значений функций. Просчитать 10 значений для каждой функции (интервал и шаг выбрать самостоятельно).

Вариант	Задание
	а	б	в
1

Определяем пользовательские функции (пишем их в уже созданном Module1 из Задания 1).



Function y(x As Single) As Single

y = Cos(3 * Application.Pi * x) + Sin(5 * Application.Pi * x)

End Function

Function z(x, y As Single) As Single

z = ((1 + x ^ 4 + x ^ 2) ^ (1 / 3) + y) / (1 + y)

End Function

Function g(x As Single) As Single

If x < 1 Then

g = Abs((x ^ 2 - 5) / x)

Else

g = x + 10

End If

End Function

Далее составляем таблицу значений и используем мастер функций.

Рисунок 2

Задание 3

Создать функцию и процедуру с использованием оператора Select Case.

Вычислить сумму премии по итогам работы магазина по следующему правилу:

- если продукции продано меньше, чем на C1 руб., то премия составит k1% от стоимости реализованной продукции;

- если продукции продано не меньше, чем на C1 руб., но меньше, чем на C2 руб., то премия составит k2%;

- если продукции продано не меньше, чем на C2 руб., но меньше, чем на C3 руб., то премия составит k3%.;

- если продукции продано не меньше, чем на C3 руб., то премия составит k4%.

Для функции создать на рабочем столе таблицу значений (минимум по одному значению из каждого интервала).

Процедура запрашивает данные с помощью оператора InputBox и выдает результат с помощью оператора MsgBox.

Вариант	Задание
	C1	C2	C3	k1	k2	k3	k4
1	10000	20000	40000	1	1,5	3	4,5

Function mycase(x As Long)

Select Case x

Case Is < 10000

mycase = x * 0.01

Case 10000 To 20000

mycase = x * 0.015

Case 20000 To 40000

mycase = x * 0.03

Case Else

mycase = x * 0.045

End Select

End Function

Sub mycase1()

Dim x, p As Double

x = InputBox("введите сумму")

Select Case x

Case Is < 10000

p = x * 0.01

Case 10000 To 20000

p = x * 0.015

Case 20000 To 40000

p = x * 0.03

Case Else

p = x * 0.045

End Select

MsgBox ("Премия составляет: " & p)

End Sub

Работа процедуры:

Рисунок 3

Задание 4

Создать процедуры с использованием операторов цикла For/Next и Do/Loop.

а) Найти сумму и произведение первых n членов ряда (использовать цикл For/Next).

б) Определить количество членов ряда, необходимых для достижения суммой значения k (использовать цикл Do/Loop).

Результат работы процедуры выдать с помощью оператора MsgBox.

	Задание
Вариант	Ряд	n	k
1	2, 4, 6, 8, …	8	110

Sub Ryad()

Dim s, n, i As Byte

Dim p As Long

s = 0

p = 1

n = 1

For i = 2 To 16 Step 2

s = s + i

p = p * i

Next i

MsgBox ("Сумма=" & s & Chr(13) & "Произведение=" & p)

End Sub

Sub MSum()

Dim n, s As Byte

n = 1

s = 2

Do

s = s + 2

n = n + 1

Loop While s <= 110

MsgBox ("Сумма = " & s & Chr(13) & "Достигнута на " & n & " члене ряда")

End Sub

Результаты:

Рисунок 4

оператор массив макрос значение

Задание 5

Создать процедуры с использованием операторов цикла For/Next и For/Each.

а) Значения элементов массива берутся из ячеек рабочего листа (ячейки должны быть предварительно заполнены). Результат вычислений вывести в ячейку рабочего листа. Для вычислений использовать цикл For/Next.

б) Размер массива вводится с помощью оператора InputBox. Массив заполнить случайными числами с помощью функции Rnd. Массив вывести в ячейки рабочего листа. Результат вычислений вывести с помощью оператора MsgBox. Для вычислений использовать цикл For/Each.

Вариант	Задание
1	Найти количество элементов массива размера 3х4, попадающих в отрезок от 1 до 5

Sub MasSum()

Dim Mas(3, 4)

Dim s, i, j As Byte

s = 0

For i = 1 To 3

For j = 1 To 4

Mas(i, j) = Cells(i, j)

If (Mas(i, j) > 1) And (Mas(i, j) < 5) Then

s = s + 1 'считаем количество

End If

Next j

Next i

Cells(4, 4) = s

End Sub

Sub MasSum2()

Dim Mas(3, 4)

Dim i, j, s As Byte, d As Variant

Dim n, m As Byte

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

m = InputBox("введите количество столбцов массива")

s = 0

For i = 1 To n

For j = 1 To m

Mas(i, j) = Int(Rnd * 10)

Cells(i + 5, j) = Mas(i, j) 'вывод массива с 6 строки

If (Mas(i, j) > 1) And (Mas(i, j) < 5) Then

s = s + 1 'считаем количество

End If

Next j

Next i

MsgBox ("колво = " & s)

End Sub



Рисунок 5

Задание 6

Создать пользовательскую форму для заполнения базы данных. Содержимое базы данных определить самостоятельно.

Форма должна содержать текстовые поля, текстовые поля со счетчиками, выпадающие списки, флажки, переключатели, кнопки.

Размер таблицы базы данных должен быть ограничен. Например, таблица может содержать до 20 записей. Если таблица уже содержит 20 строк, то при попытке добавления новой записи выдавать сообщение о том, что таблица переполнена.

Записать макрос для построения шаблона таблицы на рабочем листе. Шапка таблицы соответствует полям формы. Если на рабочем листе уже существует таблица, то при выполнении макроса она должна быть удалена.

Записать макрос для удаления выделенной строки таблицы и очистки всей таблицы.

На рабочем листе создать кнопки. Выполнение макросов назначить этим кнопкам. Для выбора способа сортировки на рабочем листе создать переключатели для определения критерия и направления сортировки. Также создать аналогичные пункты меню.

Создать на рабочем листе кнопку и пункт меню для открытия пользовательской формы.

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

Перед внесением данных в таблицу проверять, все ли поля формы заполнены. Если есть незаполненные поля, выдать сообщение с предупреждением.

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

Задание выполнено на листе «Задание 6». Тексты процедур и функций находятся в модуле Module1 и формы UserForm1 файла КР в1.xls.

Рисунок 6 - Форма

Рисунок 7 - Пункты меню



Основные процедуры и функции Формы:

'проверка все ли поля заполнены

Function prov() As Boolean

prov = True

If TextBox1 = "" Then prov = False

If TextBox2 = "" Then prov = False

If TextBox3 = "" Then prov = False

If ComboBox1 = "" Then prov = False

If ComboBox2 = "" Then prov = False

End Function

'Добавить

Private Sub CommandButton1_Click()

Dim iRow As Integer 'последния строка

Dim iStr As String

iRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count - 1

If iRow >= 23 Then

MsgBox ("БД переполнена" & Chr(13) & "Выполните очистить БД")

UserForm1.Hide

Else

If prov = False Then

MsgBox ("Все поля должны быть заполнены")

Else

Range("A" & CStr(iRow + 1)).Select

ActiveCell.Value = TextBox1.Text

ActiveCell.Offset(0, 1).Value = TextBox2.Text

ActiveCell.Offset(0, 2).Value = TextBox3.Text

ActiveCell.Offset(0, 3).Value = ComboBox1.Text

ActiveCell.Offset(0, 4).Value = ComboBox2.Text

If OptionButton1.Value = True Then

iStr = "Тверсия"

End If

If OptionButton2.Value = True Then

iStr = "Аверсия"

Else

iStr = "Рверсия"

End If

ActiveCell.Offset(0, 5).Value = iStr

If CheckBox1.Value = True Then

iStr = "Да"

Else

iStr = "Нет"

End If

ActiveCell.Offset(0, 6).Value = iStr

End If

End If

End Sub

'обработка счетчика

Private Sub SpinButton1_SpinDown()

TextBox3.Value = SpinButton1.Value

End Sub

Private Sub SpinButton1_SpinUp()

TextBox3.Value = SpinButton1.Value

End Sub



'в поле ГодИзд ограничим нажатие клавиш только числовой частью клавиатуры

Private Sub TextBox3_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

If (KeyAscii < 48) Or (KeyAscii > 57) Then

KeyAscii = 0

End If

End Sub

'Заполнение выпадающего списка Жанр при инициализации формы

Private Sub UserForm_Initialize()

OptionButton1.Value = True

ComboBox1.Clear

ComboBox1.AddItem ("Фантастика")

ComboBox1.AddItem ("Фэнтези")

ComboBox1.AddItem ("Юмор")

ComboBox1.AddItem ("Классика")

ComboBox1.AddItem ("Ужас")

ComboBox1.ListIndex = 0

ComboBox2.Clear

ComboBox2.AddItem ("AVI")

ComboBox2.AddItem ("MPEG4")

ComboBox2.AddItem ("DivX")

ComboBox2.ListIndex = 0

End Sub

Размещено на Allbest.ru