End Sub
Командой, осуществляющей переход на лист Расчёт, является команда Sheets ("Расчёт").Select
Строки, начинающиеся с кавычки, являются справочной информацией, а не командой, которая должна быть выполнена.
Аналогичным образом можно создавать макросы для перехода на другие листы. Так, макрос перехода на лист Алгоритм будет отличаться от макроса перехода на лист Расчёт только именем макроса и командой перехода, которая будет иметь следующий вид;
Sheets ("Алгоритм").Select
Рис.8
Если макрос перехода на титульный лист назовем Тит, а титульный лист называется Титул, то макрос перехода будет иметь вид (в Ваших макросах будет другая дата создания и вместо ECIT будет имя Вашего компьютера):
Sub Тит()
‘Тит Макрос
‘Макрос записан 27.10.2003 (ECIT)
Sheets ("Титул").Select
End Sub
Поскольку для перехода с любого листа рабочей книги на титульный лист макрос будет иметь один и тот же вид, то следует создать его один раз, и на каждом листе (кроме титульного) кнопке или картинке назначать один и тот же макрос.
3. Создать макрос для накопления итогов (столбец О) по начисленной заработной плате на листе Итоги, начиная с января месяца, в январе месяце следует очистить итоги. При этом надо следить за тем, чтобы не добавить итоги дважды и более в один и тот же месяц. Реализацию этой проблемы представим в виде схемы, а затем и напишем макрос.
|
 |
|
 |
Рис.9 (окончание)
Первой командой макроса является команда Sub имя макроса().
Последней командой макроса является команда End Sub.
Для выдачи окна сообщения используется функция
MsgBox (сообщение, набор кнопок, название окна).
|
|
Например, в результате выполнения функции
MsgBox("Операции по данному месяцу уже закрыты", vbOKOnly, "Ошибка") появится диалоговое окно, в котором только одна кнопка (vbOKOnly), сообщение и название окна (Рис.10).
Рис.10
В результате же выполнения функции
MsgBox("Операции по данному месяцу будут закрыты. Продолжить?", vbYesNo, "Внимание!") появится диалоговое окно (Рис.11), в котором две кнопки Да и Нет (vbYesNo), сообщение и название окна.
Рис.11
Для выполнения разветвляющегося процесса используется команда
IF (условие) Then (оператор1, если условие выполняется) Else (оператор2, если условие не выполняется).
End If
Так, для реализации блоков с второго по четвертый выполним команду
If Month(Date)=1 Then
e=12
Else
e= Month(Date)-1
End If
Условием является выражение:
Month(Date)=1,
где значение текущего месяца Month(Date) сравнивается с 1 (поскольку в первых числах месяца рассчитывается заработная плата за предыдущий месяц, а месяцем предшествующим месяц январь является месяц декабрь, т.е. е=12, во всех остальных случаях предшествующим месяцем будет число, равное номеру текущего месяца Month(Date) минус единица, т.е. Month(Date) – 1).
If Range("титул!A1").Value = e Then
Ans = MsgBox("Вы уже добавили начисленную зарплату", vbOKOnly, _ "Ошибка")
Exit Sub
Else
If e - Range("титул!A1").Value > 1 Then
Ans = MsgBox("Вы не изменяли итоги " & (е- _ Range("титул!A1").Value) & " месяцев " & "Идите за разрешением к _ директору", vbOKOnly, "Ошибка")
Exit Sub
Else
If e - Range("титул!A1").Value < 1 And e - Range("титул!A1").Value <> -11 Then
|
|
Ans = MsgBox("Вы не изменяли итоги " & (e - Range("титул!A1").Value) + _ 12 & " месяцев " & "Идите за разрешением к директору", vbOKOnly, _ "Ошибка")
Exit Sub
Else
If MsgBox("Операции по данному месяцу будут закрыты. _ Продолжить?", vbYesNo, "Внимание!") = vbNo Then
Exit Sub
End If
End If
End If
End If
Условием является выражение:
Range("титул!A1").Value = е,
где значение ячейки А1 Листа Титул (Range("титул!A1").Value) сравнивается с номером месяца расчета (поскольку в первых числах месяца рассчитывается заработная плата за предыдущий месяц, номером месяца расчета будет число, равное номеру текущего месяца Month(Date) минус единица, т.е. (Month(Date) – 1).
Первым оператором служат команда присвоения переменной Ans значения (в данном случае равное нулю), полученного в результате выполнения сообщения (константе vbOKOnly соответствует значение 0)
Ans = MsgBox("Вы уже добавили начисленную зарплату ",
vbOKOnly, "Ошибка")
и команда выхода из макроса Exit Sub
Второй оператор содержит команду условного перехода
If e - Range("титул!A1").Value > 1 Then
Ans = MsgBox("Вы не изменяли итоги " & (е- _ Range("титул!A1").Value) & " месяцев " & "Идите за разрешением к _ директору", vbOKOnly, "Ошибка")
Exit Sub
Else
If e - Range("титул!A1").Value < 1 And e - Range("титул!A1").Value <> -11 Then
Ans = MsgBox("Вы не изменяли итоги " & (e - Range("титул!A1").Value) + _ 12 & " месяцев " & "Идите за разрешением к директору", vbOKOnly, _ "Ошибка")
Exit Sub
Else
If MsgBox("Операции по данному месяцу будут закрыты. _ Продолжить?", vbYesNo, "Внимание!") = vbNo Then
|
|
Exit Sub
End If
End If
End If
В данном случае опять используется команда IF.
Условием является выражение e - Range("титул!A1").Value > 1
Первым оператором второй команды IF является команда присвоения переменной Ans значения, полученного в результате выполнения сообщения MsgBox("Вы не изменяли итоги " & (е- _ Range("титул!A1").Value) & " месяцев " & "Идите за разрешением к _ директору", vbOKOnly, "Ошибка")
Exit Sub
и команда выхода из макроса Exit Sub
Второй оператор содержит команду условного перехода
If e - Range("титул!A1").Value < 1 And e - Range("титул!A1").Value <> _ -11 Then
Ans = MsgBox("Вы не изменяли итоги " & (e - Range("титул!A1").Value) + _ 12 & " месяцев " & "Идите за разрешением к директору", vbOKOnly, _ "Ошибка")
Exit Sub
Else
If MsgBox("Операции по данному месяцу будут закрыты. _ Продолжить?", vbYesNo, "Внимание!") = vbNo Then
Exit Sub
End If
End If
Вторым оператором этой команды IF неполная форма команды IF, где есть только первый оператор и нет второго.
Условие является функция MsgBox("Операции по данному месяцу будут закрыты. Продолжить?", vbYesNo, "Внимание!", значение которой зависит от того, какая кнопка будет нажата пользователем. Если будет нажата кнопка Yes, то значение будет равно 13, если No, то значение будет равно 12(24). В правой части находится vbNo, что соответствует 12 (24).
В результате выполнения команды произойдёт следующее:
Если пользователь нажмет кнопку vbNo, то он выйдет из макроса (выполнится команда Exit Sub). В противном случае он перейдёт к выполнению команды, следующей за командой IF.
Если программный код не помещается на одно строке, то для переноса строки кода на следующую строку, в конце строки ставится пробел и знак подчеркивания.
Блоки с 14 по 23 представляют собой разветвляющийся процесс, содержащий две ветви. Каждая из ветвей содержит циклический процесс.
If Range("титул!A1").Value <> 12 Then
Range("титул!A1").Value = Range("титул!A1").Value + 1
I = 6
While Worksheets("алгоритм").Cells(I, 15).Value <> ""
Worksheets("итоги").Cells(I,15).Value= _
Worksheets("итоги").Cells(I,15).Value+ _
Worksheets("алгоритм").Cells(I, 15).Value
I = I + 1
Wend
Else
Range("титул!A1").Value = 1
I = 6
While Worksheets("алгоритм").Cells(I, 15).Value <> ""
Worksheets("итоги").Cells(I, 15).Value = 0
I = I + 1
Wend
End If
Команда Range("титул!A1").Value = Range("титул!A1").Value + 1
добавляет к номеру предыдущего месяца единицу.
Команда I = 6 задаёт номер первой строки на листе Алгоритм, на которой расположены данные. Команда начала цикла
While Worksheets("алгоритм").Cells(I, 15).Value <> "" означает:
Цикл выполняется до тех пор, пока значение (Value) ячейки, расположенной на пересечении I -ой строки и 15 –го столбца (т.е в первом случае O6, а затем со сменой значения I, номера ячеек будут О7,О8 и т.д.) на рабочем листе (Worksheets "алгоритм") не равно пробелу (т.е. не достигли конца расчетно-платёжной ведомости).
Повторяющаяся команда цикла
Worksheets("итоги").Cells(I,15).Value= _
Worksheets("итоги").Cells(I,15).Value+ _
Worksheets("алгоритм").Cells(I, 15).Value
К ячейке Оi рабочего листа и тоги прибавляет данные с рабочего листа алгоритм. Команда I = I + 1 изменяет номер строки.
Команда Wend является концом цикла.
Во второй ветке команды If присваивается значение 1( т.е месяц расчета Январь) ячейке А1 листа Титул и последовательно очищаются ячейки столбца О листа алгоритм.
Программа имеет вид:
Sub итоги()
'Определение месяца расчета
If Month(Date) = 1 Then
e = 12
Else
e = Month(Date) - 1
End If
‘Проверка своевременности добавления итогов
If Range("титул!A1").Value = e Then
Ans = MsgBox("Вы уже добавили начисленную зарплату", vbOKOnly, _ "Ошибка")
Exit Sub
Else
If e - Range("титул!A1").Value > 1 Then
Ans = MsgBox("Вы не изменяли итоги " & (е- _ Range("титул!A1").Value) & " месяцев " & "Идите за разрешением к _ директору", vbOKOnly, "Ошибка")
Exit Sub
Else
If e - Range("титул!A1").Value < 1 And e - Range("титул!A1").Value <>-11 _ Then
Ans = MsgBox("Вы не изменяли итоги " & (e - Range("титул!A1").Value) + _ 12 & " месяцев " & "Идите за разрешением к директору", vbOKOnly, _ "Ошибка")
Exit Sub
Else
If MsgBox("Операции по данному месяцу будут закрыты. _ Продолжить?", vbYesNo, "Внимание!") = vbNo Then
Exit Sub
End If
End If
End If
End If
' Накопление итогов
If Range("титул!A1").Value <> 12 Then
‘ Прибавление начисленной суммы
Range("титул!A1").Value = Range("титул!A1").Value + 1
I = 6
While Worksheets("алгоритм").Cells(I, 15).Value <> ""
Worksheets("итоги").Cells(I, 15).Value = Worksheets("итоги").Cells(I, 15).Value + Worksheets("алгоритм").Cells(I, 15).Value
I = I + 1
Wend
Else
‘ Очистка итогов
Range("титул!A1").Value = 1
I = 6
While Worksheets("алгоритм").Cells(I, 15).Value <> ""
Worksheets("итоги").Cells(I, 15).Value = 0
I = I + 1
Wend
End If
Sheets("титул").Select
End Sub
Подготовка данных для расчёта средней заработной платы за три предыдущих месяца
Прежде чем начать расчёт заработной платы в следующий расчётный период, вначале необходимо перезаписать остатки, т.е. расчётно-платёжную ведомость с листа пред3 сохранить на вновь созданном листе и дать листу имя, соответствующее номеру месяца и года расчётно-платёжной ведомости. Расчётно-платёжную ведомость с листа пред2 переписать на лист пред3, а с листа пред1 на лист пред2, с листа алгоритм переписать на лист пред1.
Для этого создадим макрос, который бы формировал:
новый лист для перенесения на него расчетно-платёжную ведомость с листа пред3;
переносил данные с листа пред2 на лист пред3;
переносил данные с листа пред1 на лист пред2;
переносил данные с листа алгоритм на лист пред1;
следил за тем, чтобы мы эту работу выполняли только один раз в месяц.
Этот макрос имеет следующий вид:
Sub остаток()
' остаток Макрос
' Макрос записан 18.06.2003 (Домашний компьютер)
Dim d As String, C As String, B As String
'определение номера месяца для перезаписи остатков с листа пред3
If Month(Date) = 1 Then
A = 9
Else
If Month(Date) = 2 Then
A = 10
Else
If Month(Date) = 3 Then
A = 11
Else
If Month(Date) = 4 Then
A = 12
Else
A = Month(Date) - 4
End If
End If
End If
End If
If A = 1 Then
C = "январь"
Else
If A = 2 Then
C = "февраль"
Else
If A = 3 Then
C = "март"
Else
If A = 4 Then
C = "апрель"
Else
If A = 5 Then
C = "май"
Else
If A = 6 Then
C = "июнь"
Else
If A = 7 Then
C = "июль"
Else
If A = 8 Then
C = "август"
Else
If A = 9 Then
C = "сентябрь"
Else
If A = 10 Then
C = "октябрь"
Else
If A = 11 Then
C = "ноябрь"
Else
If A = 12 Then
C = "декабрь"
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
If Month(Date) = 1 Then
e = 12
Else
e = Month(Date) - 1
End If
If Range("титул!A2").Value = e Then
Ans = MsgBox("Операции по данному месяцу уже закрыты", vbOKOnly, "Ошибка")
Exit Sub
Else
If MsgBox("Операции по данному месяцу будут закрыты. Продолжить?", vbYesNo, "Внимание!") = vbNo Then
Exit Sub
End If
End If
If Range("титул!A2").Value <> 12 Then
Range("титул!A2").Value = Range("титул!A2").Value + 1
Else
Range("титул!A2").Value = 1
End If
'формирование имени листа для перезаписи остатков
'с листа пред3
If Month(Date) - 1 < 4 Then
B = Str(Year(Date) - 1)
Else
B = Str(Year(Date))
End If
d = C & B
Sheets(1).Select
If Worksheets(1).Name = d Then
Ans = MsgBox("Лист с таким именем уже есть", vbOKOnly, "Ошибка")
Exit Sub
Else
Sheets.Add
Worksheets(1).Name = d
End If
Sheets("пред3").Select
Range("A1:AA20").Select
Selection.Copy
Sheets(1).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'копирование с листа "пред2" на лист "пред3"
Sheets("пред2").Select
Range("A1:AB20").Select
Selection.Copy
Sheets("пред3").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'копирование с листа "пред1" на лист "пред2"
Sheets("пред1").Select
Range("A1:AB20").Select
Selection.Copy
Sheets("пред2").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'копирование с листа "алгоритм" на лист "пред1"
Sheets("алгоритм").Select
Range("A1:AS20").Select
Selection.Copy
Sheets("пред1").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("титул").Select
End Sub
