Лист «Табель учета рабочего времени»
На листе расположена информация о рабочих завода. Указаны их Ф.И.О., наименование цеха, специальность, количество отработанных дней, зарплата, удержания и сумма к выдаче.
На листе «Табель учета рабочего времени» расположены кнопки «Среднемесячный заработок» и « Отмена».
Макросы для кнопок:
Sub имя()
' имя Макрос
Range("H10").Select
ActiveCell.FormulaR1C1 = "Среднемесячный заработок всех рабочих"
Range("H11").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(RC[-3]:R[64]C[-3])"
End Sub
Sub удалить()
' удалить Макрос
Range("H10").Select
ActiveCell.FormulaR1C1 = ""
Range("H11").Select
ActiveCell.FormulaR1C1 = ""
End Sub
Так же на листе «Табель учёта рабочего времени» расположена одна кнопка Меню.
К кнопке привязан следующий код:
Private Sub CommandButton1_Click()
menu.Show
End Sub
При нажатии на кнопку Меню появляется пользовательская форма Меню.
Меню представляет собой форму с кнопками Автофильтр, Сортировка, Фильтрация, Отмена фильтра, поиск и изменение данных, ВПР , Добавление данных, Удаление данных, а также есть кнопки перехода на другие листы приложения.
Для кнопок созданы следующие программные коды:
Кнопка Автофильтр:
Private Sub CommandButton1_Click()
Range("A10:G10").Select
Selection.AutoFilter
End Sub
Кнопка Сортировка: При нажатии на кнопку Сортировка появляется форма Сортировка
На форме расположены кнопки, позволяющие проводить сортировку по ФИО, наименованию цеха, по специальностям, по количеству отработанных дней, а также можно отметить тип сортировки по возрастанию или по убыванию, а также на форме содержится кнопка Отмена.
Программные коды для формы Сортировка:
Private Sub CommandButton1_Click()
If OptionButton1 = True Then
Range("A10:G1000").Select
Selection.Sort Key1:=Range("A11"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
ElseIf OptionButton2 = True Then
Range("A10:G1000").Select
Selection.Sort Key1:=Range("A11"), Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End If
End Sub
Private Sub CommandButton2_Click()
If OptionButton1 = True Then
Range("A10:G1000").Select
Selection.Sort Key1:=Range("B10"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
ElseIf OptionButton2 = True Then
Range("A10:G1000").Select
Selection.Sort Key1:=Range("B10"), Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End If
End Sub
Private Sub CommandButton3_Click()
If OptionButton1 = True Then
Range("A10:G1000").Select
Selection.Sort Key1:=Range("C10"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
ElseIf OptionButton2 = True Then
Range("A10:G1000").Select
Selection.Sort Key1:=Range("C10"), Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End If
End Sub
Private Sub CommandButton4_Click()
If OptionButton1 = True Then
Range("A10:G1000").Select
Selection.Sort Key1:=Range("D10"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
ElseIf OptionButton2 = True Then
Range("A10:G1000").Select
Selection.Sort Key1:=Range("D10"), Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End If
End Sub
Private Sub CommandButton5_Click()
sor.Hide
End Sub
Кнопка Фильтрация:
Private Sub CommandButton3_Click()
Range("G2").Select
ActiveCell.FormulaR1C1 = InputBox("Введите наименование специальности")
Range("A10").Select
Range("A10:G500").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("G1:G2"), Unique:=False
End Sub
Кнопка Отмена фильтра:
Private Sub CommandButton4_Click()
ActiveSheet.ShowAllData
End Sub
Кнопка Поиск и изменение данных. При нажатии на кнопку Поиск и изменение данных появляется форма Поиск и изменение данных.
Программный код:
Dim sss, ads
Private Sub ComboBox1_Change()
ListBox3.Clear
TextBox1.Text = ""
TextBox2.Text = ""
1 For sss = 10 To 5000
If ComboBox1.Text = Sheets("Табель учета рабочего времени").Cells(sss, 2).Text Then
ListBox3.AddItem Sheets("Табель учета рабочего времени").Cells(sss, 1).Text
End If
Next
End Sub
Private Sub CommandButton1_Click()
For sss = 10 To 8000
If ComboBox1.Text = Sheets("Табель учета рабочего времени").Cells(sss, 2).Text And ListBox3.Text = Sheets("Табель учета рабочего времени").Cells(sss, 1).Text Then
Worksheets("Табель учета рабочего времени").Cells(sss, 4) = TextBox2.Text
End If
Next
ListBox3.Clear
TextBox1.Text = ""
TextBox2.Text = ""
End Sub
Private Sub CommandButton2_Click()
iz.Hide
End Sub
Private Sub ListBox3_Click()
For sss = 10 To 8000
If ComboBox1.Text = Sheets("Табель учета рабочего времени").Cells(sss, 2).Text And ListBox3.Text = Sheets("Табель учета рабочего времени").Cells(sss, 1).Text Then
TextBox1.Text = Sheets("Табель учета рабочего времени").Cells(sss, 3).Text
TextBox2.Text = Sheets("Табель учета рабочего времени").Cells(sss, 4).Text
End If
Next
End Sub
Private Sub UserForm_Activate()
Sheets("Табель учета рабочего времени").Select
Range("A10:G8000").Select
Selection.Sort Key1:=Range("B10"), Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
1 For ads = 11 To 8000
If Sheets("Табель учета рабочего времени").Cells(ads, 2).Text = "" Then Exit Sub
If Sheets("Табель учета рабочего времени").Cells(ads, 2).Text = Sheets("Табель учета рабочего времени").Cells(ads + 1, 2).Text Then GoTo 3
ComboBox1.AddItem Sheets("Табель учета рабочего времени").Cells(ads, 2).Text
3 Next
End Sub
Кнопка Добавление данных: При нажатии на кнопку Добавление данных появляется форма Добавление рабочего.
Программный код:
Private Sub ComboBox1_Enter()
ActiveWorkbook.Sheets("Тарифы").Select
Dim i As Integer
Dim j As Integer
Dim a As Integer
Dim строка As Integer
строка = Application.CountA(Sheets("Табель учета рабочего времени").Columns(1))
i = 3
Do While i <= строка
i = i + 1
If Cells(i, 1) = " " Then
j = i
Exit Do
End If
Loop
For a = 3 To i
ComboBox1.AddItem Cells(a, 1)
Next a
Sheets("Табель учета рабочего времени").Select
End Sub
Private Sub CommandButton1_Click()
Dim текущая As Object
Dim следующая As Object
If TextBox1 = " " Or TextBox2 = " " Or ComboBox1 = " " Or TextBox3 = " " Then
MsgBox (" Введены не все данные")
Exit Sub
End If
ActiveWorkbook.Sheets("Табель учета рабочего времени").Select
Set текущая = ActiveSheet.Range("A11")
Do While Not IsEmpty(текущая)
Set следующая = текущая.Offset(1, 0)
Set текущая = следующая
Loop
текущая.Value = TextBox1.Text
текущая.Offset(0, 1).Value = TextBox2.Text
текущая.Offset(0, 2).Value = ComboBox1.Text
текущая.Offset(0, 3).Value = TextBox3.Text
текущая.Offset(0, 4).Value = "=VLOOKUP(RC[-2],Тарифы!R3C1:R7C2,2,FALSE)*RC[-1]"
текущая.Offset(0, 5).Value = "=RC[-1]*13%"
текущая.Offset(0, 6).Value = "=RC[-2]-RC[-1]"
MsgBox " Поздравляю, добавлен новый рабочий!"
End Sub
Private Sub CommandButton2_Click()
dr.Hide
End Sub
Private Sub TextBox3_Change()
If TextBox3.Value < 0 Then
MsgBox " Числа не должны быть отрицательные!", vbOKOnly + vbInformation
TextBox3.SetFocus
End If
If Not IsNumeric(TextBox3.Text) And Len(TextBox3) <> 0 Then
MsgBox "Вводить надо чиловые данные!", vbOKOnly + vbInformation
TextBox3.Value = " "
TextBox3.SetFocus
End If
End Sub
Private Sub TextBox1_Change()
If IsNumeric(TextBox1.Text) And Len(TextBox1) <> 0 Then
MsgBox " Надо вводить только текстовые данные!", vbOKOnly + vbInformation
TextBox1.Value = ""
TextBox1.SetFocus
End If
End Sub
Private Sub TextBox2_Change()
If IsNumeric(TextBox2.Text) And Len(TextBox2) <> 0 Then
MsgBox " Надо вводить только текстовые данные!", vbOKOnly + vbInformation
TextBox2.Value = ""
TextBox2.SetFocus
End If
End Sub
Кнопка Удаление данных: При нажатии на кнопку Удаление данных появляется форма Удаление рабочего.
Программный код:
Private Sub ComboBox1_Change()
ActiveWorkbook.Sheets("Табель учета рабочего времени").Select
Dim i As Integer
Dim j As Integer
Dim a As Integer
Dim строка As Integer
строка = Application.CountA(Sheets("Табель учета рабочего времени").Columns(1))
i = 10
Do While i <= строка
i = i + 1
If Cells(i, 1) = " " Then
j = i
Exit Do
End If
Loop
For a = 11 To i
If ComboBox1.Text = Cells(a, 1).Value Then
TextBox1.Value = Cells(a, 2)
TextBox2.Value = Cells(a, 3)
TextBox3.Value = Cells(a, 4)
End If
Next a
End Sub
Private Sub CommandButton1_Click()
If ComboBox1.Text = Empty Then
MsgBox "Вы должны выбрать фамилию рабочего"
Else
f = MsgBox("Сейчас произойдет удаление", vbOKCancel)
End If
If f = vbOK Then
Sheets("Табель учета рабочего времени").Select
Dim i As Integer
Dim j As Integer
Dim строка As Integer
строка = Application.CountA(Sheets("Табель учета рабочего времени").Columns(1))
i = 11
Do While i <= строка
i = i + 1
If Cells(i, 1) = " " Then
j = i
Exit Do
End If
Loop
For b = 11 To i
If ComboBox1.Text = Cells(b, 1) Then
Cells(b, 1).Select
Selection.EntireRow.Delete
End If
Next b
End If
End Sub
Private Sub CommandButton2_Click()
ud.Hide
End Sub
Private Sub TextBox1_Change()
If IsNumeric(TextBox1.Text) And Len(TextBox1) <> 0 Then
MsgBox " Надо вводить только текстовые данные!", vbOKOnly + vbInformation
TextBox1.Value = ""
TextBox1.SetFocus
End If
End Sub
Private Sub TextBox2_Change()
If IsNumeric(TextBox2.Text) And Len(TextBox2) <> 0 Then
MsgBox " Надо вводить только текстовые данные!", vbOKOnly + vbInformation
TextBox2.Value = ""
TextBox2.SetFocus
End If
End Sub
Private Sub TextBox3_Change()
If TextBox3.Value < 0 Then
MsgBox "Числа не должны быть отрицательные!", vbOKOnly + vbInformation
TextBox3.SetFocus
End If
If Not IsNumeric(TextBox3.Text) And Len(TextBox3) <> 0 Then
MsgBox "Вводить надо числовые данные!", vbOKOnly + vbInformation
TextBox3.Value = ""
TextBox3.SetFocus
End If
End Sub
Private Sub UserForm_Activate()
TextBox1.Text = " "
TextBox2.Text = " "
TextBox3.Text = ""
ComboBox1.Text = " "
End Sub
Private Sub ComboBox1_Enter()
ComboBox1.Clear
Sheets("Табель учета рабочего времени").Select
Dim i As Integer, j As Integer, строка As Integer
строка = Application.CountA(Sheets("Табель учета рабочего времени").Columns(1))
i = 11
Do While i <= строка
i = i + 1
If Cells(i, 1) = " " Then
j = i
Exit Do
End If
Loop
For a = 11 To i
ComboBox1.AddItem Cells(a, 1)
Next a
End Sub
Переход на другие листы приложения осуществляется с помощью кнопок, программные коды которых были описаны на листе «Титульный лист».