LibreOffice/Скрипт - Статистика системы допуска
Приведённый ниже скрипт обрабатывает данные выгруженные из системы ограничения допуска в помещение.
Входными данными для скрипта является таблица на листе "исх данные" со следующими колонками:
- Дата/Время -
- Фамилия
- Имя
- Отчество
- Должность
- Событие
- Зона доступа
- Направление
- Табельный номер
- Подразделение
- Телефон
Скрипт создаёт общий отчёт, затем при утвердительном ответе на запросы а диалоговом окне, создаёт отчёты для каждого подразделения, страницы с исходными данными для каждого отдела и сводный отчёт по сотрудникам. Каждый отчёт создаётся на отдельной странице и к ячейкам применяются стили оформления: выделяются опоздания, переработки, работа в выходные дни. Также выдаются предупреждения о странных записях: двойной вход или выход, вход без выхода в этот же день и т.п. Подсчитывается итог трудочасов по человеку, отделу и предприятию. Создаются сводные отчёты за месяц для рабочего времени, переработок и опозданий.
Можно скачать файл с примером. В файле есть исходные данные, макрос и стили оформления.
Для запуска скрипта необходимо включить макросы в LibreOffice:
Сервис - Параметры - Безопасность - Безопасность макросов - Уровень безопасности: средний
и выполнить главную процедуру в макросе, которая вызовет все остальные:
Сервис - Макросы - Выполнить макрос - Учёт времени (пример) - Standard - WorkTime - WorktimeReport
Для просмотра и изменения кода макроса:
Сервис - Макросы - Управление макросами - LibreOffice Basic - Правка
Предварительные требования к листу с исходными данными:
- Данные берутся из 1-го листа, со 2-й строки (первая содержит название столбцов и не учитывается)
- Строки должны быть отсортированы по Подразделению (столбец J) и по вторичному ключу Фамилия (столбец B)
REM ***** LibreOffice BASIC for Calc 4.x *****
'
' Автор: Павел Малахов, 24pm@mail.ru
'
' Этот скрипт использует стили ячеек, которые желательно создать заранее:
' pm-Время - ячейки со временем
' pm-Заголовок - заголовок колонки в таблице
' pm-Заголовок общий - заголовок отчёта
' pm-Итого - итоговые ячейки
' pm-Сотрудник - заголовок отчёта по сотруднику
'
'
' Предварительные требования к листу с исходными данными:
' - Данные берутся из 1-го листа, со 2-й строки (первая содержит название столбцов и не учитывается)
' - Строки должны быть отсортированы по Подразделению (столбец J) и по вторичному ключу Фамилия (столбец B)
'
'
' Заметки:
' - Скрипт работает медленнее, если включен вид "Разметка страницы". Для ускорения нужно переключить в вид "Обычный"
'
' История изменений:2014.09.04 - первая полнофункциональная версия
' 2014.12.17 - Исправлено: Если был зарегистрирован только вход, то данные следующего человека учитывались в текущем. Добавлена переменная tab_person
'
'==== Общие для всех модулей процедуры и функции ====
'==== Константы ====
Const dayStatusHoliday = 0
Const dayStatusShort = 1
Const dayStatusWork = 2
'Определение времени начала и окончания рабочего дня в формате Часы:Минуты:Секунды
Const timeWorkStart As Date = "08:00:00"
Const timeWorkEnd As Date = "17:15:00"
Const timeWorkEndShort As Date = "15:00:00"
Const timeZero As Date = "00:00:01" 'если полный ноль, то это минус сутки
Const timeWorkOver As Date = "00:15:00" 'переработка < 15 мин не учитывается
' Преобразует дату в строку
' cDate() - не подходит, т.к. возвращает строку в формате "ММ.ДД.ГГГГ ЧЧ:ММ:СС"
Function DateTimeToString(dt As Date) As String
DateTimeToString = Year(dt) & "." & Month(dt) & "." & Day(dt) & " " & Hour(dt) & ":" & Minute(dt)
End Function 'DateTimeToString
' Возвращает количество дней в месяце
Function DaysInMonth(dt As Date) As Integer
Dim days As Integer
days = 28
If IsDate( "29." & Month(dt) & "." & Year(dt) ) Then
days = 29
End If
If IsDate("30." & Month(dt) & "." & Year(dt)) Then
days = 30
End If
If IsDate("31." & Month(dt) & "." & Year(dt)) Then
days = 31
End If
DaysInMonth = days
End Function 'DaysInMonth
' Возвращает статус текущего дня: выходной (0), предпраздничный (1) или рабочий (2)
Function DayStatus(dt As Date) As Integer
Dim status As Integer
Dim next_day As Date
status = -1
next_day = DateAdd("d", 1, dt)
If IsHoliday(dt) Then 'выходной
status = dayStatusHoliday
ElseIf ( (WeekDay(dt) = 6) OR isHoliday(next_day) ) Then 'короткий день, предпраздничный
status = dayStatusShort
Else 'обычный рабочий день
status = dayStatusWork
End If
DayStatus = status
End Function 'DayStatus
Function IsHoliday(dt As Date) As Boolean
Dim result As Boolean
Dim str_day As String
Dim holidays(27)
result = false
str_day = Month(dt) & "." & Day(dt)
holidays(0) = "1.1" '1—6 и 8 января — Новогодние каникулы
holidays(1) = "1.2"
holidays(2) = "1.3"
holidays(3) = "1.4"
holidays(4) = "1.5"
holidays(5) = "1.6"
holidays(6) = "1.7" '7 января — Рождество Христово
holidays(7) = "1.8"
holidays(8) = "2.22" '22—23 февраля — День защитника Отечества
holidays(9) = "2.23"
holidays(10) = "3.8" '8—10 марта — Международный женский день
holidays(11) = "3.9"
holidays(12) = "3.10"
holidays(13) = "5.1" '1—4 мая — Праздник Весны и Труда
holidays(14) = "5.2"
holidays(15) = "5.3"
holidays(16) = "5.4"
holidays(17) = "5.9" '9—11 мая — День Победы
holidays(18) = "5.10"
holidays(19) = "5.11"
holidays(20) = "6.12" '12—15 июня — День России
holidays(21) = "6.13"
holidays(22) = "6.14"
holidays(23) = "6.15"
holidays(24) = "11.1" '1—4 ноября — День народного единства
holidays(25) = "11.2"
holidays(26) = "11.3"
holidays(27) = "11.4"
'суббота и воскресенье
If (WeekDay(dt) = 7) OR (WeekDay(dt) = 1) Then
result = true
End If
'государственные праздники, выходные дни
For i=0 To UBound(holidays)
If str_day = holidays(i) Then
result = true
Exit For
End If
Next
IsHoliday = result
End Function 'IsHoliday
Function NameWeekDay(dt As Date) As String
Dim wd(7)
wd(0) = "Название дня недели"
wd(1) = "Вс"
wd(2) = "Пн"
wd(3) = "Вт"
wd(4) = "Ср"
wd(5) = "Чт"
wd(6) = "Пт"
wd(7) = "Сб"
NameWeekDay = wd(WeekDay(dt))
End Function 'NameWeekDay
Function NameMonth(i As Integer) As String
Dim m(12)
m(0) = "Название месяца"
m(1) = "Январь"
m(2) = "Февраль"
m(3) = "Март"
m(4) = "Апраель"
m(5) = "Май"
m(6) = "Июнь"
m(7) = "Июль"
m(8) = "Август"
m(9) = "Сентябрь"
m(10) = "Октябрь"
m(11) = "Ноябрь"
m(12) = "Декабрь"
NameMonth = m(i)
End Function 'NameMonth
'Возвращает буквенный индекс колонки (до 2-х букв) по её числовому значению от А до ZZ 26*26=676
Function ColumnLetter(num As Integer) As String
Dim letter(27)
Dim x, y As Integer
Dim str As String
letter(0) = ""
letter(1) = "A"
letter(2) = "B"
letter(3) = "C"
letter(4) = "D"
letter(5) = "E"
letter(6) = "F"
letter(7) = "G"
letter(8) = "H"
letter(9) = "I"
letter(10) = "J"
letter(11) = "K"
letter(12) = "L"
letter(13) = "M"
letter(14) = "N"
letter(15) = "O"
letter(16) = "P"
letter(17) = "Q"
letter(18) = "R"
letter(19) = "S"
letter(20) = "T"
letter(21) = "U"
letter(22) = "V"
letter(23) = "W"
letter(24) = "X"
letter(25) = "Y"
letter(26) = "Z"
'имя колонки до ZZ, num <= 676
If num > 25 Then
x = Int(num / 26) 'целая часть от делелния
y = num MOD 26 +1 'остаток
Else
x = num +1
y = 0
End If
'формирование названия колонки без ограничения
'x = Int(num / 26) 'целая часть от делелния
'While x > 0
' str = letter()
' x = x MOD 26 +1 'остаток
'Wend
ColumnLetter = letter(x) & letter(y)
End Function 'ColumnLetter
'==== Константы ====
'Определение колонок в исходной таблице
Const colDate = 0
Const colFamily = 1
Const colName = 2
Const colOtch = 3
Const colDolznost = 4
Const colDostup = 5
Const colZone = 6
Const colZoneName = 7
Const colTabelNumber= 8
Const colOtdel = 9
Const colRoom =10
'Определение колонок и строк в отчёте
Const rowReportStart= 3 'первая строка отчёта(начиная с заголовка колонок)
Const colRepFIO = 0 'колонка для вывода ФИО сотрудника и его отдела
Const colRepWeekDay = 0 'День недели
Const colRepDate = 1 'Дата
Const colRepTime = 2 'Интервал времени рабочего дня
Const colRepWorkDay = 3 'Общее время рабочего дня
Const colRepInside = 4 'Общее время в здании
Const colRepOutside = 5 'Общее время вне здания
Const colRepWorkOver= 6 'Общее время вне здания
Const colRepTimeLate = 7 'Общее время вне здания
Const colRepComment = 8 'Комментарий
Const colRepDebug = 9 'Отладочная информация
'==== Локальные переменные (только для этого модуля) ====
Private Doc As Object
Private sheet_source As Object ' Лист с данными
Private sheet_report As Object ' Лист с отчётом
Private cell As Object 'для форматирования ячеек. Доп инфо: http://www.openoffice.org/api/docs/common/ref/com/sun/star/table/CellProperties.html
Private str_msg, report_month_name As String 'строка предупреждений и название месяца отчёта
Private str1, str2, str3 As String 'времянки
Private str_fio, otdel_cur, otdel_prev, str_time As String
Private date_min, date_max As Date 'период отчёта
Private date_cur, date_next As Date 'дата в текущей и последующей строке
Private work_start, work_end As Date 'начало и конец рабочего дня
Private time_start, time_end As Date 'начало и конец рабочего дня сотрудника
Private time_all, time_work, time_rest As Date 'общее время, длительность нахождения в здании и вне здания
Private time1, time2 As Date 'промежуточные значения
Private row_source, row_report, row_sum_first As Integer 'номера текущих (обрабатываемых) строк в исходной таблице и отчёте
Private zone_cur, zone_next, tab_cur, tab_prev As Integer 'значения полей "зона доступа" и "табельный номер"
Private counter_persons, counter_otdel, counter_otdel_staff As Integer 'счётчики сотрудников, отделов и сотрудников в отделе на предприятии
Private row_otdel_source_start, row_otdel_source_end, row_otdel_report_start, row_otdel_report_end As Integer 'строки отчёта по отделу
Private first_record_in_day As Boolean 'первая запись у этого человека для этого дня
'Общие для всех массивов константы
Const aName = 0 'наименование предприятия, отдела, ФИО
Const aWorkDay = 1 'общее время рабочего дня
Const aInside = 2 'общее время в здании
Const aOutside = 3 'общее время вне здания
Const aWorkOver = 4 'общее время переработки
Const aTimeLate = 5 'общее время опоздания
Private array_ent(5) 'данные по предприятию
Private array_otdel(10,50) ' array_otdel(x,y) - таблица данных по всем отделам
' y = 0 - первая строка - название столбцов
' y = 1..50 - номер отдела, строка с данными по отделу
' x - номер столбца:
Const aoSrcStart = 6 'первая строка записей по отделу на листе с исходными данными
Const aoSrcEnd = 7 'последняя строка --"--
Const aoRepStart = 8 'первая строка записей по отделу на листе с общим отчётом
Const aoRepEnd = 9 'последняя строка --"--
Const aoOtdStaff = 10 'кол-во сотрудников в отделе
Private array_month(32,100,2) 'array_month(x,y,z) - данные по сотруднику
' x = 0 - колонки: 1-я = ФИО сотрудника
' x = 1 - колонки: 2-я = отдел
' x = 1..31 - данные по сотрудникам на каждый день месяца
' y = 0 - строки: 1-я название месяца и дней недели
' y = 1..100- номер сотрудника и его данные
' z - таблицы: разные отчётные данные
Const amTableWorkDay = 0
Const amTableWorkOver = 1
Const amTableTimeLate = 2
Const amOtdel = 1 'название отдела сотрудника
'==== Локальные процедуры и функции ====
' Вывод в ячейку отчётного листа:
' --- строки
Sub SetString (col As Integer, row As Integer, str As String)
sheet_report.getCellByPosition(col, row).setString(str)
End Sub
' --- формулы
Sub SetFormula (col As Integer, row As Integer, str As String)
sheet_report.getCellByPosition(col, row).setFormula(str)
End Sub
' --- числа
Sub SetValue (col As Integer, row As Integer, val As Double)
sheet_report.getCellByPosition(col, row).setValue(val)
End Sub
' Получить из ячейки листа с исходными данными значение в виде:
' --- строки
Function GetString (col As Integer, row As Integer) As String
GetString = sheet_source.getCellByPosition(col, row).getString()
End Function
' --- числа
Function GetValue (col As Integer, row As Integer) As Double
GetValue = sheet_source.getCellByPosition(col, row).getValue()
End Function
' Вывод заголовка отчёта и названия столбцов
Sub OUTHeader(sheet_dest As Object)
Dim c As Object
c = sheet_dest.getCellRangeByPosition(colRepDate, 0, colRepComment, 0)
c.Merge(true)
c.getCellByPosition(0,0).setString("Учёт рабочего времени")
c.CellStyle = "pm-Заголовок общий"
sheet_dest.getCellByPosition(colRepDate, rowReportStart).setString("Дата")
sheet_dest.getCellByPosition(colRepTime, rowReportStart).setString("Период работы")
sheet_dest.getCellByPosition(colRepWorkDay, rowReportStart).setString( "Рабочий день")
sheet_dest.getCellByPosition(colRepInside, rowReportStart).setString( "В здании")
sheet_dest.getCellByPosition(colRepOutside, rowReportStart).setString("Вне здания")
sheet_dest.getCellByPosition(colRepWorkOver, rowReportStart).setString("Переработка")
sheet_dest.getCellByPosition(colRepTimeLate, rowReportStart).setString("Опоздания")
sheet_dest.getCellByPosition(colRepComment, rowReportStart).setString("Комментарий")
c = sheet_dest.getCellRangeByPosition(colRepDate, rowReportStart, colRepComment, rowReportStart)
c.CellStyle = "pm-Заголовок"
End Sub 'OUTHeader
' Визуальное закрытие отчёта строкой с таким же форматом как и заголовок
Sub OUTFooter(sheet_dest As Object, row As Integer, str As String)
Dim c As Object
c = sheet_dest.getCellRangeByPosition(colRepDate, row, colRepComment, row)
c.Merge(true)
c.getCellByPosition(0,0).setString(str)
c.CellStyle = "pm-Заголовок"
End Sub 'OUTFooter
' Вывод статистики по пользователю
Sub OUTStatisticsPerson
SetString(colRepTime, row_report, "Итого: ")
SetFormula(colRepWorkDay, row_report, "=SUM(" & ColumnLetter(colRepWorkDay) & row_sum_first & ":" & ColumnLetter(colRepWorkDay) & row_report & ")")
SetFormula(colRepInside, row_report, "=SUM(" & ColumnLetter(colRepInside) & row_sum_first & ":" & ColumnLetter(colRepInside) & row_report & ")")
SetFormula(colRepOutside, row_report, "=SUM(" & ColumnLetter(colRepOutside) & row_sum_first & ":" & ColumnLetter(colRepOutside) & row_report & ")")
SetFormula(colRepWorkOver, row_report,"=SUM(" & ColumnLetter(colRepWorkOver)& row_sum_first & ":" & ColumnLetter(colRepWorkOver)& row_report & ")")
SetFormula(colRepTimeLate, row_report,"=SUM(" & ColumnLetter(colRepTimeLate)& row_sum_first & ":" & ColumnLetter(colRepTimeLate)& row_report & ")")
array_otdel(aWorkDay, counter_otdel+1) = array_otdel(aWorkDay, counter_otdel+1) + sheet_report.getCellByPosition(colRepWorkDay, row_report).getValue()
array_otdel(aInside, counter_otdel+1) = array_otdel(aInside, counter_otdel+1) + sheet_report.getCellByPosition(colRepInside, row_report).getValue()
array_otdel(aOutside, counter_otdel+1) = array_otdel(aOutside, counter_otdel+1) + sheet_report.getCellByPosition(colRepOutside, row_report).getValue()
array_otdel(aWorkOver, counter_otdel+1) = array_otdel(aWorkOver, counter_otdel+1)+ sheet_report.getCellByPosition(colRepWorkOver, row_report).getValue()
array_otdel(aTimeLate, counter_otdel+1) = array_otdel(aTimeLate, counter_otdel+1)+ sheet_report.getCellByPosition(colRepTimeLate, row_report).getValue()
cell = sheet_report.getCellRangeByPosition(colRepTime, row_report, colRepComment, row_report)
cell.CellStyle = "pm-Итого"
row_report = row_report + 1
End Sub 'OUTStatisticsPerson
' Вывод статистики по отделу
Sub OUTStatisticsOtdel
counter_otdel = counter_otdel + 1
SetString(colRepTime, row_report, "Итого по отделу: ")
SetValue(colRepWorkDay, row_report, array_otdel(aWorkDay, counter_otdel))
SetValue(colRepInside, row_report, array_otdel(aInside, counter_otdel))
SetValue(colRepOutside, row_report, array_otdel(aOutside, counter_otdel))
SetValue(colRepWorkOver, row_report, array_otdel(aWorkOver, counter_otdel))
SetValue(colRepTimeLate, row_report, array_otdel(aTimeLate, counter_otdel))
cell = sheet_report.getCellRangeByPosition(colRepTime, row_report, colRepComment, row_report)
cell.CellStyle = "pm-Итого"
row_report = row_report + 1
array_otdel(aName, counter_otdel) = otdel_prev
array_otdel(aoOtdStaff, counter_otdel) = counter_otdel_staff
array_otdel(aoSrcStart, counter_otdel+1) = row_source + 1
array_otdel(aoSrcEnd, counter_otdel) = row_source - 1
array_otdel(aoRepStart, counter_otdel+1) = row_report
array_otdel(aoRepEnd, counter_otdel) = row_report - 1
array_ent(aWorkDay) = array_ent(aWorkDay) + array_otdel(aWorkDay, counter_otdel)
array_ent(aInside) = array_ent(aInside) + array_otdel(aInside, counter_otdel)
array_ent(aOutside) = array_ent(aOutside) + array_otdel(aOutside, counter_otdel)
array_ent(aWorkOver) = array_ent(aWorkOver) + array_otdel(aWorkOver, counter_otdel)
array_ent(aTimeLate) = array_ent(aTimeLate) + array_otdel(aTimeLate, counter_otdel)
InitArrayOtdel(counter_otdel+1)
counter_otdel_staff = 0
End Sub 'OUTStatisticsOtdel
'Выводим итоги по всему предприятию
Sub OUTStatisticsEnterprise()
report_month_name = NameMonth(Month(date_min))
SetString(colRepTime, row_report, "Итого по предприятию: ")
SetValue(colRepWorkDay, row_report, array_ent(aWorkDay))
SetValue(colRepInside, row_report, array_ent(aInside))
SetValue(colRepOutside, row_report, array_ent(aOutside))
SetValue(colRepWorkOver, row_report, array_ent(aWorkOver))
SetValue(colRepTimeLate, row_report, array_ent(aTimeLate))
cell = sheet_report.getCellRangeByPosition(colRepTime, row_report, colRepComment, row_report)
cell.CellStyle = "pm-Итого"
row_report = row_report + 1
OUTFooter(sheet_report, row_report, "Всего человек: " & counter_persons)
row_report = row_report + 1
'Добавляем статистику в заголовок
SetString(colRepDate, 1, "Начало:")
SetString(colRepDate, 2, "Окончание:")
SetString(colRepTime, 1, DateTimeToString(date_min) )
SetString(colRepTime, 2, DateTimeToString(date_max) )
SetString(colRepWorkDay, 1, "Отделов:")
SetString(colRepWorkDay, 2, "Человек:")
SetString(colRepInside, 1, counter_otdel)
SetString(colRepInside, 2, counter_persons)
End Sub 'OUTStatisticsEnterprise
Sub InitArrayOtdel(i As Integer)
'Название полей в массиве отделов и номера строк данных для первого отдела
array_otdel(aName, 0) = "Отдел"
array_otdel(aoSrcStart, 0) = "Исх. начало"
array_otdel(aoSrcEnd, 0) = "Иск. конец"
array_otdel(aoRepStart, 0) = "Отчёт начало"
array_otdel(aoRepEnd, 0) = "Отчёт конец"
array_otdel(aWorDay, 0) = "Раб день"
array_otdel(aInside, 0) = "В здании"
array_otdel(aOutside, 0) = "Вне здания"
array_otdel(aWorkOver, 0) = "Переработка"
array_otdel(aTimeLate, 0) = "Опоздание"
array_otdel(aWorkDay, i) = TimeValue("00:00:00")
array_otdel(aInside, i) = TimeValue("00:00:00")
array_otdel(aOutside, i) = TimeValue("00:00:00")
array_otdel(aWorkOver, i) = TimeValue("00:00:00")
array_otdel(aTimeLate, i) = TimeValue("00:00:00")
End Sub 'InitArrayOtdel
Sub InitArrayEnterprise()
array_ent(aWorkDay) = TimeValue("00:00:00")
array_ent(aInside) = TimeValue("00:00:00")
array_ent(aOutside) = TimeValue("00:00:00")
array_ent(aWorkOver)= TimeValue("00:00:00")
array_ent(aTimeLate)= TimeValue("00:00:00")
End Sub 'InitArrayEnterprise
Sub InitArrayMonth()
Dim i,j As Integer
Dim m As String
For i=0 To 2
array_month(aName,0,i) = "ФИО"
array_month(amOtdel,0,i)= "Отдел"
For j=1 To 31
array_month(amOtdel + j,0,i) = j
Next
Next
End Sub 'InitArrayMonth
' Создание листа
Function CreateSheet(sheetName As String, index As Integer) As Object
' Удаляем (если есть) и создаём новый лист с именем sheetName
If Doc.Sheets.hasByName(sheetName) Then
Doc.Sheets.removeByName(sheetName)
End If
'Можно было бы не привязываться к номеру листа, но не ясно пока как получить индекс листа по его имени Sheet.getIndex() не работает
'Dim Sheet As Object
'Sheet = Doc.createInstance("com.sun.star.sheet.Spreadsheet")
'Doc.Sheets.insertByName(sheetName, Sheet)
Doc.Sheets.insertNewByName(sheetName, index)
CreateSheet = Doc.Sheets.getByName(sheetName)
End Function 'CreateSheet
'Показываем переработки и опоздания
Sub ShowOverTimeAndLate()
Dim dStatus, dDay As Integer
Dim dToday, time_over, time_late, tZero, t As Date
Dim str1, str2, str3, str4, str5 As String
tZero = TimeValue("00:00:01") 'не воспринимает константу timeZero в сравнении ниже (несмотря на то, что константа timeWorkOver воспринимается нормально)
dToday = DateValue(Month(time_start) & "/" & Day(time_start) & "/" & Year(time_start))
time_late = time_start - dToday - TimeValue(timeWorkStart)
' str2 = DateTimeToString(timeZero)
' str3 = DateTimeToString(tZero)
' str4 = DateTimeToString(t)
' str5 = DateTimeToString(time_late)
If time_late < tZero Then 'это уже не опоздание, а преждевременный приход
time_late = tZero
End If
dStatus = DayStatus(date_cur)
Select Case dStatus
Case dayStatusHoliday
cell.CellBackColor = RGB(255, 175, 175) 'помечаем всю строку как выходной день
SetValue(colRepWorkOver, row_report, time_work) 'всё время - переработка
time_late = tZero 'опозданий нет
Case dayStatusShort
cell.CellBackColor = RGB(175, 255, 175) 'помечаем всю строку как короткий день
time_over = time_end - dToday - TimeValue(timeWorkEndShort) - time_late
Case dayStatusWork
time_over = time_end - dToday - TimeValue(timeWorkEnd) - time_late
End Select
'отладка
str1 = DateTimeToString(time_over)
str2 = DateTimeToString(time_end)
str3 = DateTimeToString(dToday)
str4 = DateTimeToString(TimeValue(timeWorkEnd))
str5 = DateTimeToString(time_late)
dDay = Day(time_start)
array_month(dDay, counter_persons+1,amTableWorkDay) = time_work
t = TimeValue(timeWorkOver)
If dStatus <> dayStatusHoliday Then
If time_over > t Then 'задержка < timeWorkOver не считается за переработку
cell = sheet_report.getCellByPosition(colRepWorkOver, row_report)
cell.CellBackColor = RGB(255, 175, 175)
cell.Value = time_over
array_month(dDay, counter_persons+1,amTableWorkOver) = time_over
End If
If time_late > tZero Then
cell = sheet_report.getCellByPosition(colRepTimeLate, row_report)
cell.CellBackColor = RGB(255, 255, 99)
cell.Value = time_late
array_month(dDay, counter_persons+1,amTableTimeLate) = time_late
End If
End If
str5 = ""
End Sub 'ShowOverTimeAndLate
'Переносим исходные данные каждого отдела на отдельный лист
Sub SplitSource()
Dim i As Integer
Dim sheet_out As Object 'лист отдела для копирования туда данных
Dim c As Object 'ячейка, временный объект
Dim range_header As New com.sun.star.table.CellRangeAddress 'область заголовка
Dim cell_header As New com.sun.star.table.CellAddress 'адрес ячейки куда копировать заголовок
Dim range_data As New com.sun.star.table.CellRangeAddress 'область данных
Dim cell_data As New com.sun.star.table.CellAddress 'адрес ячейки куда копировать данные
cell_header.Sheet = 2 'Индекс листа задаётся в функции CreateSheet
cell_header.Column = 0
cell_header.Row = 1
range_header.Sheet = 0 'лист с исходными данными
range_header.StartColumn= 0
range_header.StartRow = 0
range_header.EndColumn = 10
range_header.EndRow = 0
For i=1 To counter_otdel
sheet_out = CreateSheet(array_otdel(aName, i) & " (исх)",2)
cell_data.Sheet = 2 'Индекс листа задаётся в функции CreateSheet
cell_data.Column= 0
cell_data.Row = 2
range_data.Sheet = 0
range_data.StartColumn = 0
range_data.StartRow = array_otdel(aoSrcStart, i)
range_data.EndColumn = 10
range_data.EndRow = array_otdel(aoSrcEnd, i)
c = sheet_out.getCellRangeByPosition(0, 0, 10, 0)
c.Merge(true)
c.getCellByPosition(0,0).setString("Исходные данные по отделу: " & array_otdel(aName, i))
c.CellStyle = "pm-Заголовок"
sheet_out.getCellByPosition(0, 0).setString("Исходные данные по отделу: " & array_otdel(aName, i) ) ' & " -- " & j)
sheet_out.copyRange(cell_header, range_header)
sheet_out.copyRange(cell_data, range_data)
Col = sheet_out.Columns(0)
Col.OptimalWidth = true
Next
End Sub 'SplitSource
'Переносим отчёт по каждому отделу на отдельный лист
Sub SplitReport()
Dim i,j As Integer
Dim sheet_out As Object 'лист отдела для копирования туда данных
Dim c As Object 'ячейка, временный объект
Dim range_header As New com.sun.star.table.CellRangeAddress 'область заголовка
Dim cell_header As New com.sun.star.table.CellAddress 'адрес ячейки куда копировать заголовок
Dim range_data As New com.sun.star.table.CellRangeAddress 'область данных
Dim cell_data As New com.sun.star.table.CellAddress 'адрес ячейки куда копировать данные
For i=1 To counter_otdel
sheet_out = CreateSheet(array_otdel(aName, i), 2)
cell_data.Sheet = 2 'Индекс листа задаётся в функции CreateSheet
cell_data.Column= 0
cell_data.Row = rowReportStart + 1
range_data.Sheet = 1 'лист с общим отчётом
range_data.StartColumn = 0
range_data.StartRow = array_otdel(aoRepStart, i)
range_data.EndColumn = colRepComment
range_data.EndRow = array_otdel(aoRepEnd, i)
sheet_out.copyRange(cell_data, range_data)
OUTHeader(sheet_out)
'Добавляем статистику в заголовок
sheet_out.getCellByPosition(colRepDate, 1).SetString("Начало:")
sheet_out.getCellByPosition(colRepDate, 2).SetString("Окончание:")
sheet_out.getCellByPosition(colRepTime, 1).SetString(DateTimeToString(date_min) )
sheet_out.getCellByPosition(colRepTime, 2).SetString(DateTimeToString(date_max) )
sheet_out.getCellByPosition(colRepWorkDay, 1).SetString("Отдел:")
sheet_out.getCellByPosition(colRepWorkDay, 2).SetString("Человек:")
sheet_out.getCellByPosition(colRepInside, 1).SetString(array_otdel(aName, i) )
sheet_out.getCellByPosition(colRepInside, 2).SetString(array_otdel(aoOtdStaff, i) )
OUTFooter(sheet_out, rowReportStart + array_otdel(aoRepEnd, i) - array_otdel(aoRepStart, i) + 2, "Всего человек: " & array_otdel(aoOtdStaff, i))
'Выравниваем ширину столбцов
For j=0 To colRepComment
Col = sheet_out.Columns(j)
Col.OptimalWidth = true
Next
Next
End Sub 'SplitReport
'Сводный отчёт за месяц
Sub MonthReport()
Dim i, j, t, row, row_start, row_end, col, col_end, col_date_start As Integer
Dim sheet_out, c As Object 'лист отчёта и ячейка для форматирования
Dim str As String
sheet_out = CreateSheet("Сводный отчёт", 2)
'Добавляем статистику в заголовок
sheet_out.getCellByPosition(0,0).setString("Начало:")
sheet_out.getCellByPosition(0,1).setString("Окончание:")
sheet_out.getCellByPosition(1,0).setString(DateTimeToString(date_min))
sheet_out.getCellByPosition(1,1).setString(DateTimeToString(date_max))
sheet_out.getCellByPosition(2,0).setString("Отделов:")
sheet_out.getCellByPosition(2,1).setString("Человек:")
sheet_out.getCellByPosition(3,0).setString(counter_otdel)
sheet_out.getCellByPosition(3,1).setString(counter_persons)
row = 2
col_date_start = 3
For t=0 To 2 'Выводим даннные трёх таблиц: Общее рабочее время, Переработка и Опоздания
'Заголовок таблицы
Select Case t
Case 0
str = "Сводный отчёт рабочего времени за "
Case 1
str = "Сводный отчёт переработок за "
Case 2
str = "Сводный отчёт опозданий за "
End Select
col_end = UBound(array_month) + 1 - (31 - DaysInMonth(date_min) )
c = sheet_out.getCellRangeByPosition(0, row, col_end, row)
c.Merge(true)
c.getCellByPosition(0,0).setString(str & report_month_name)
c.CellStyle = "pm-Заголовок общий"
row = row + 1
'Оформляем заголовок
c = sheet_out.getCellRangeByPosition(0, row, col_end, row)
c.CellStyle = "pm-Заголовок"
'Выводим данные по всем сотрудникам
row_start = row + 1
For i=0 To counter_persons
'Выводим порядковый номер
If i > 0 Then
sheet_out.getCellByPosition(0, row).SetString( i )
sheet_out.getCellByPosition(col_end +1, row).SetFormula("=SUM(" & ColumnLetter(col_date_start) & row +1 & ":" & ColumnLetter(col_end) & row +1 & ")")
End If
'Выводим ФИО, отдел и отчёт по дням
'days_in_month =
For j=0 To col_end - 1
If Not IsEmpty(array_month(j,i,t)) Then
If IsNumeric(array_month(j,i,t)) Or IsDate(array_month(j,i,t)) Then
sheet_out.getCellByPosition(j+1, row).SetValue( array_month(j,i,t) )
Else
sheet_out.getCellByPosition(j+1, row).SetString( array_month(j,i,t) )
End If
End If
Next
row = row + 1
Next 'все сотрудники
row_end = row - 1
row = row + 1
'выделяем выходные и считаем статистику за день
Dim dDay As Date
Dim dStatus As Integer
for col = col_date_start To col_end
dDay = DateValue(Month(time_start) & "/" & col - col_date_start +1 & "/" & Year(time_start))
c = sheet_out.getCellRangeByPosition(col, row_start, col, row_end + 1)
dStatus = DayStatus(dDay)
Select Case dStatus
Case dayStatusHoliday
c.CellBackColor = RGB(255, 175, 175) 'помечаем как выходной день
Case dayStatusShort
c.CellBackColor = RGB(175, 255, 175) 'помечаем как короткий день
End Select
sheet_out.getCellByPosition(col, row -1).SetFormula("=SUM(" & ColumnLetter(col) & row_start + 1 & ":" & ColumnLetter(col) & row_end +1 & ")")
Next
'статистика за месяц по предприятию
sheet_out.getCellByPosition(col, row -1).SetFormula("=SUM(" & ColumnLetter(col) & row_start + 1 & ":" & ColumnLetter(col) & row_end +1 & ")")
'применяем преднастроенный стиль отображения времени
c = sheet_out.getCellRangeByPosition(col_date_start, row_start, col_end+1, row_end +1)
c.CellStyle = "pm-Время"
c = sheet_out.getCellRangeByPosition(col_date_start, row_end +1, col_end+1, row_end +1)
c.CellStyle = "pm-Итого"
c = sheet_out.getCellRangeByPosition(col_end+1, row_start, col_end+1, row_end +1)
c.CellStyle = "pm-Итого"
Next 'все таблицы
'Выравниваем ширину столбцов
For i=0 To col_end + 1
c = sheet_out.Columns(i)
c.OptimalWidth = true
Next
' For col=0 To 700
' colLetter = ColumnLetter(col)
' sheet_out.getCellByPosition(col, 0).SetString(colLetter)
' Next
End Sub 'MonthReport
'
'------- Главная процедура -------------------------------------------------------------
'
Sub WorktimeReport
'Инициализируем переменные всего отчёта
Doc = ThisComponent
sheet_source = Doc.Sheets (0)
sheet_report = CreateSheet("Отчёт (общий)", 1)
'не работает почему-то: число записей черезчур велико. НАДО: проверить синтаксис метода!
'msgbox ("Начинаю формировать отчёт. Количество записей: " & sheet_source.Rows().getCount())
row_source = 1
row_report = rowReportStart
row_otdel_source_start = row_source
row_otdel_report_start = row_report
counter_persons = 0
counter_otdel = 0
counter_otdel_staff = 0
tab_prev = -1 'для учёта самой первой строки данных
otdel_prev = "none"
InitArrayOtdel(counter_otdel+1)
InitArrayEnterprise()
InitArrayMonth()
'Выводим заголовок отчёта
OUTHeader(sheet_report)
row_report = row_report + 1
array_otdel(aoSrcStart, 1) = row_source
array_otdel(aoRepStart, 1) = row_report
'Цикл = Человек. Обходим все строки в таблице
Do
'Считываем исходные данные
date_cur = GetValue(colDate, row_source)
str_fio = GetString(colFamily, row_source) & " " & GetString(colName, row_source) & " " & GetString(colOtch, row_source)
zone_cur = GetValue(colZone, row_source)
tab_cur = GetValue(colTabelNumber, row_source)
tab_next = GetValue(colTabelNumber, row_source + 1)
otdel_cur = GetString(colOtdel, row_source)
If tab_cur <> tab_prev Then 'Новый человек.
For i=0 to 2
array_month(aName, counter_persons+1,i) = str_fio
array_month(amOtdel,counter_persons+1,i) = otdel_cur
Next
If tab_prev <> -1 Then 'Это не первый человек в списке. Выводим статистику по предыдущему
OUTStatisticsPerson()
If otdel_cur <> otdel_prev Then 'Новый отдел. Выводим статистику по предыдущему отделу
OUTStatisticsOtdel()
End If
End If
'Выводим заголовок для нового человека
cell = sheet_report.getCellRangeByPosition(colRepDate, row_report, colRepComment, row_report)
cell.Merge(true)
cell.getCellByPosition(0,0).setString(str_fio & " (" & otdel_cur & ", таб. № " & tab_cur & ")") 'координаты (0,0) внутри области
cell.CellStyle = "pm-Сотрудник"
counter_persons = counter_persons + 1
counter_otdel_staff = counter_otdel_staff + 1
row_report = row_report + 1
row_sum_first = row_report +1
End If
date_min = date_cur
date_max = date_cur
date_prev = DateValue("01.01.2000")
zone_prev = -1
Otdel_prev = "none"
first_record_in_day = true
tab_person = tab_cur 'чтобы отслеживать смену человека в том же дне
'Цикл = День. Обработка всех записей для человека в пределах одного дня. Формируем отчёт по каждому дню.
While (date_prev <= date_cur) and (tab_cur = tab_person)
date_next = GetValue(colDate, row_source + 1)
time1 = TimeValue( Hour(date_prev) & ":" & Minute(date_prev) & ":" & Second(date_prev) )
time2 = TimeValue( Hour(date_cur) & ":" & Minute(date_cur) & ":" & Second(date_cur) )
str_time = time1 & ", " & time2
str_msg = ""
If first_record_in_day Then 'вычисляем начало и конец рабочего дня
time_start = date_cur
SetString(colRepWeekDay, row_report, NameWeekDay(date_cur) )
SetString(colRepDate, row_report, Year(date_cur) & "." & Month(date_cur) & "." & Day(date_cur))
If date_cur > date_max Then
date_max = date_cur
End If
If date_cur < date_min Then
date_min = date_cur
End If
End If
If zone_cur = zone_prev Then 'повторная регистрация на том же считывателе
If zone_cur = 1 Then
str_msg = str_msg & " Повторный вход: " & str_time
Else
str_msg = str_msg & " Повторный выход: " & str_time
End If
Else 'запись не повторная, нужно учесть
If first_record_in_day Then 'первая запись в текущем дне
time_work = 0
time_rest = 0
Else
If zone_cur = 0 Then 'выход из здания, считаем проведённое в нём время
time_work = time2 - time1 + time_work
Else 'вход в здание, считаем сколько человек отсутствовал
time_rest = time2 - time1 + time_rest
End If
End If
End If
If (Day(date_cur) <> Day(date_next)) Or (tab_cur <> tab_next) Then ' последняя запись для текущего дня
time_end = date_cur
time_all = time_end - time_start
str_time = Hour(time_start) & ":" & Minute(time_start) & " - " & Hour(time_end) & ":" & Minute(time_end)
'SetString(colRepDebug, row_report, "Последняя: " & str_date_cur )
SetString(colRepTime, row_report, str_time)
SetValue(colRepWorkDay, row_report, time_all)
SetValue(colRepInside, row_report, time_work)
SetValue(colRepOutside, row_report, time_rest)
cell = sheet_report.getCellRangeByPosition(colRepWorkDay, row_report, colRepTimeLate, row_report)
cell.CellStyle = "pm-Время"
'cell = sheet_report.getCellRangeByPosition(colRepWeekDay, row_report, colRepComment, row_report)
'Вычисляем время опозданий и переработок
ShowOverTimeAndLate()
'array_month(counter_persons+1, amOtdel, amTableTimeLate) = otdel_cur
time_work = timeZero
time_rest = timeZero
If first_record_in_day Then
str_msg = str_msg & " Только одна регистрация! "
End If
first_record_in_day = true 'следующая запись будет первой в новом дне
row_report = row_report + 1
Else 'ещё одна запись для текущего дня
first_record_in_day = false
End If
SetString(colRepComment, row_report, str_msg)
'переходим на следующую строку
date_prev = date_cur
zone_prev = zone_cur
row_source = row_source + 1
date_cur = GetValue(colDate, row_source)
zone_cur = GetValue(colZone, row_source)
tab_prev = tab_cur
tab_cur = GetValue(colTabelNumber, row_source)
tab_next = GetValue(colTabelNumber, row_source + 1)
Wend 'обработка одного дня
otdel_prev = otdel_cur
str_fio = GetString(colFamily, row_source) & " " & GetString(colName, row_source) & " " & GetString(colOtch, row_source)
otdel_cur = GetString(colOtdel, row_source)
tab_cur = GetValue(colTabelNumber, row_source)
'SetString(colRepDebug, row_report, row_source & ". ФИО: " & str_fio & "; таб.№ " & tab_cur)
Loop Until str_fio = " " 'обработка одного человека
'Выводим итоги по последнему человеку, отделу и всему предприятию
OUTStatisticsPerson()
OUTStatisticsOtdel()
OUTStatisticsEnterprise()
'регулируем ширину столбцов согласно содержимому
Dim Col As Object
For i=0 To colRepComment
Col = sheet_report.Columns(i)
Col.OptimalWidth = true
Next
'Создаём листы отчёта для каждого отдела
If MsgBox ("Общий отчёт для " & counter_persons & " человек сформирован. Создать отдельные листы отчётов по отделам?", MB_YESNO + MB_DEFBUTTON2 + MB_ICONQUESTION) = IDYES Then
SplitReport()
EndIf
'Копируем в отдельные листы исходные данные по отделам и их отчёты
If MsgBox ("Создать отдельные листы с исходными данными по отделам?", MB_YESNO + MB_DEFBUTTON2 + MB_ICONQUESTION) = IDYES Then
SplitSource()
EndIf
'Cоздаём сводный отчёт по всем дням месяца и всем сотрудникам
If MsgBox ("Составить сводный отчёт на каждый день по каждому сотруднику?", MB_YESNO + MB_DEFBUTTON2 + MB_ICONQUESTION) = IDYES Then
MonthReport()
EndIf
'отладка: выводим весь массив отделов
'For i=0 To counter_otdel
' For j=0 To 4
' SetString(colRepDebug + j, row_report + i, array_otdel(j, i) )
' Next
'Next
MsgBox ("Создание отчёта завершено.", MB_OK)
End Sub 'WorktimeReport
'=========================================================================================
'Фиктивная процедура с полезной информацией. Для удобства доступа через "Каталог объектов"
Sub HELP_AND_SAMPLES()
'--Диалоговое окно
'Dim iBox as Integer
'iBox = MB_YESNO + MB_DEFBUTTON2 + MB_ICONQUESTION
'If MsgBox ("Do you want to continue?", iBox) = IDYES Then
'--Ячейка
'cell.HoriJustify = com.sun.star.table.CellHoriJustify.CENTER -- выравнивание по горизонтали
'cell.CellBackColor = RGB(125, 125, 255) -- фон
'cell.clearContents(com.sun.star.sheet.CellFlags.HARDATTR) -- очищаем всё форматирование
'if Cell.Type = com.sun.star.table.CellContentType.EMPTY Then -- пустая ячейка
'& chr(13) & -- перенос строки в ячейке
'LBound(MyArray), UBound(MyArray) -- нижний и верхний индексы массива
'Sheet.Rows().getCount() -- выдаёт большое число, а не номер последней заполненной строки
'=SUM(G2;G87) -- суммирование диапазона, букву можно получать через функцию: G = Letter(colName)
'======= Internet links =======
'http://ru.scribd.com/doc/99684510/LibreOffice-3-Basic-Guide -- PDF книга
'http://forumooo.ru - русско-язычный форум
'https://forum.openoffice.org/en/forum/ - форум с примерами
'https://wiki.openoffice.org/wiki/Documentation/BASIC_Guide/Structure_of_Spreadsheets
'http://www.openoffice.org/api/docs/common/ref/com/sun/star/table/TableRow.html
'
'https://help.libreoffice.org/Basic/Basic_Help/ru Справка по LibreOffice Basic]
End Sub
