LibreOffice/Скрипт - Статистика системы допуска

From SysadminWiki.ru
Jump to: navigation, search

Приведённый ниже скрипт обрабатывает данные выгруженные из системы ограничения допуска в помещение.

Входными данными для скрипта является таблица на листе "исх данные" со следующими колонками:

  • Дата/Время -
  • Фамилия
  • Имя
  • Отчество
  • Должность
  • Событие
  • Зона доступа
  • Направление
  • Табельный номер
  • Подразделение
  • Телефон

Скрипт создаёт общий отчёт, затем при утвердительном ответе на запросы а диалоговом окне, создаёт отчёты для каждого подразделения, страницы с исходными данными для каждого отдела и сводный отчёт по сотрудникам. Каждый отчёт создаётся на отдельной странице и к ячейкам применяются стили оформления: выделяются опоздания, переработки, работа в выходные дни. Также выдаются предупреждения о странных записях: двойной вход или выход, вход без выхода в этот же день и т.п. Подсчитывается итог трудочасов по человеку, отделу и предприятию. Создаются сводные отчёты за месяц для рабочего времени, переработок и опозданий.

Можно скачать файл с примером. В файле есть исходные данные, макрос и стили оформления.

Для запуска скрипта необходимо включить макросы в LibreOffice:

  • Сервис - Параметры - Безопасность - Безопасность макросов - Уровень безопасности: средний

и выполнить главную процедуру в макросе, которая вызовет все остальные:

  • Сервис - Макросы - Выполнить макрос - Учёт времени (пример) - Standard - WorkTime - WorktimeReport

Для просмотра и изменения кода макроса:

  • Сервис - Макросы - Управление макросами - LibreOffice Basic - Правка

Предварительные требования к листу с исходными данными:

  • Данные берутся из 1-го листа, со 2-й строки (первая содержит название столбцов и не учитывается)
  • Строки должны быть отсортированы по Подразделению (столбец J) и по вторичному ключу Фамилия (столбец B)


Скачать файл Учёт времени (пример).ods
Отчёт входа-выхода в помещение (скрипт LibreOffice VBA)
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