Макросы в excel график работы

Печатаем график работы для списка сотрудников на выбранную дату

Введение

Мы решили сделать обзорное видео и показать Вам один из вариантов настройки автоматической печати рабочего графика в Excel. Представьте себе ситуацию: с определенной периодичностью Вы формируете рабочий график для своих сотрудников в Excel, после чего, Вам необходимо распечатать эти графики для каждого сотрудника на каждый день. Что Вы будете делать? 

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

Скачать файл из этой статьи

Рабочий файл

Обзорное видео смотрите ниже. Приятного просмотра!

В современном мире для работы по-прежнему нужно прогонять через принтер горы бумаги. Если Вы ежедневно сталкиваетесь с печатью большого количества бланков, договоров, графиков, планов и т.п. в Excel, то пришла пора задуматься об автоматизации этого процесса. 

Мы покажем пример автоматической печати сменного рабочего графика на примере розничного магазина одежды. Аналогичные сменные рабочие графики используются в различных сферах, вроде строительства, производства или медицины.

Исходные данные

Имеется таблица, где формируется рабочий график.

График работы магазина с 10:00 до 22:00. В столбцах:

А – даты

В – операции

С – сотрудники

D-AB – занятость в минутах (интервал 30 минут)

AC – общая загруженность в % (8 часов — 100%). Рассчитывается как сумма занятости по операции деленная на 480

AD – общая загруженность в часах (8 часов — максимальная загруженность). Рассчитывается как сумма занятости по операции деленная на 60

Приводим лист к нужному виду

Первым делом сделаем из нашего диапазона «умную» таблицу Excel. Делается это сочетанием клавиш Ctrl+T.

Теперь, при добавлении новой даты, диапазон нашей таблицы будет автоматически растягиваться.

Для того, чтобы было удобнее отслеживать загруженность сотрудника, создадим сводную таблицу и на ее основе построим сводную диаграмму, которую разместим на текущем листе.

Вставка -> Сводная таблица -> На новый лист

Поля сводной таблицы на рисунке ниже.

Результат сводной таблицы:

Далее вкладка «Анализ» -> Сводная диаграмма

Выбираем обычную гистограмму.

Настроим ее форматирование на свой вкус и перенесем на лист рядом с рабочим графиком.

Такая диаграмма позволяет оперативно отслеживать загруженность сотрудников за день.

Справа от гистограммы создаем список сотрудников. В ячейке AQ2 прописываем формулу =ЕСЛИ(AR2=ИСТИНА;1;0) и копируем ее на ячейки ниже. Форматированием скрываем видимость результата в столбце AQ (устанавливаем белый цвет шрифта).

Рядом в колонку AQ добавляем флажки, а также формируем шаблон для выбора дат. Именно здесь мы и будем указывать для каких сотрудников и на какие даты нам требуется напечатать рабочий график.

Флажки связываем со столбцом AR.

Из списка сотрудников создаем выпадающие списки в «умной» таблице (для удобства заполнения).

Далее, для того чтобы не вводить даты вручную, а брать их из введенных значений, нам потребуется создать список уникальных дат из таблицы.

Из списка имеющихся дат создаем именованный диапазон с именем «Исходный».

Далее добавляем новый столбец перед столбцом с датами, назовем его «Уникальные даты» и добавим в диапазон таблицы.

В ячейку А2 вставляем формулу массива: =ЕСЛИОШИБКА(ИНДЕКС(Исходный;ПОИСКПОЗ(СУММ(СЧЁТЕСЛИ(A$1:A1; Исходный));СЧЁТЕСЛИ(Исходный;"<"& Исходный);0));"")

Копируем формулу на ячейки ниже и задаем формат «Дата».

Далее создаем именованный диапазон:

Имя: «Даты»

Диапазон: =СМЕЩ('График рабочих смен'!$A$2;0;0;СЧЁТЗ(Таблица1[Уникальные даты])-СЧИТАТЬПУСТОТЫ(Таблица1[Уникальные даты]))

Полученный именованный диапазон «Даты» используем в качестве источника для списка в столбцах AT.

Настраиваем подсказку по вводу:

Скрываем столбец А. В целом все готово для автоматизации печати.

Сохраняем книгу как файл с поддержкой макросов (xlsm).

Сочетанием клавиш Alt+F11 попадаем в окно Visual Basic.

Создаем два новых модуля: Insert – Module

В первый модуль вставляем код:

Public Sub Filter()
    'Проверяем что сотрудник и дата для печати выбраны'
        If Application.Sum(Range("AR2:AR13")) = 0 Or Application.Sum(Range("AT2:AT8")) = 0 Then
            MsgBox ("Выберите сотрудника и дату")
        Else
            'Цикл пробегающий по списку сотрудников'
            For s = 2 To 14 Step 1
                'Условие для выбора сотрудника'
                If Range("AR" + CStr(s)) = 1 Then
                    Set tbl = [A1].CurrentRegion
                    tbl.AutoFilter Field:=4, Criteria1:=Range("AQ" + CStr(s))
                    'Подсчет указанных дат'
                     ndate = Application.WorksheetFunction.CountA(Columns(46)) - 1
                    'Цикл пробегающий по всем датам'
                    For i = 1 To ndate Step 1
                        Set tbl = [A1].CurrentRegion
                        tbl.AutoFilter Field:=2, Criteria1:="=" & Format(Range("AT" + CStr(2 + i - 1)), "dd.mm.yy")
                        'Определяем последнюю видимую строку в фильтре по столбцу с фамилией сотрудника'
                        LastRow = ActiveSheet.Cells(1, 4).SpecialCells(xlLastCell).Row
                        'Проверяем наличие графика на протяжении всего кода'
                            If LastRow = 1 Then
                                MsgBox ("Рабочий график отсутствует")
                            Else
                            'Копируем таблицу'
                            Range(Cells(1, 2), Cells(LastRow, 31)).Select
                            Selection.Copy
                            'Создаем новую книгу'
                            Workbooks.Add
                            'Вставляем таблицу в ячейку A5'
                            Range("A5").Select
                            ActiveSheet.Paste
                            'Добавляем основную информацию'
                            Application.ScreenUpdating = False
                            Range("A1").FormulaR1C1 = "Дата"
                            Range("A2").FormulaR1C1 = "Сотрудник"
                            Range("A3").FormulaR1C1 = "Время"
                            Range("B1").FormulaR1C1 = "=R[5]C[-1]"
                            Range("B2").FormulaR1C1 = "=R[4]C[1]"
                            Range("B1:B2").Select
                            Selection.Copy
                            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                            Application.CutCopyMode = False
                            Application.ScreenUpdating = True
                            'Считаем количество непустых столбцов'
                            a = 1
                                For c = 4 To 28 Step 1
                                    If Application.Sum(Range(Cells(6, c), Cells(25, c))) <> 0 Then
                                    a = a + 1
                                    End If
                                Next c
                            a = a - 1 'Убираем лишнюю исходную a'
                                'Цикл пробегающий по всему времени от 4 столбца до 4+CountCell'
                                For y = 4 To a + 4 Step 1
                                'Подсчет корректности графика во времени'
                                n = Application.WorksheetFunction.CountA(Columns(y))
                                    If n = 1 Then
                                        Columns(y).Delete
                                        y = y - 1
                                    End If
                                Next y

                            'Указываем итоговое рабочее время'
                            Range("B3") = Cells(5, 4)
                            Range("C3") = Cells(5, 3 + a)
                            Range("B3:C3").Select
                            Selection.Copy
                            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                :=False, Transpose:=False
                            Application.CutCopyMode = False
                                'Проверяем наличие загруженности'
                                If Range("B3") = "Общая загруженность (%)" Or Range("C3") = "Операция" Then
                                    Range("B3") = "Без загрузки"
                                    Range("C3").ClearContents
                                End If
                            'Подбираем автоматически ширину для столбцов'
                            Columns("A:AJ").EntireColumn.AutoFit
                            'Запускаем макрос сортировки'
                            Call Sort
                            'номер последнего столбца'
                            lastCol = Cells(6, Columns.Count).End(xlToLeft).Column

                            'номер последней строки'
                            LastRow = Cells(Rows.Count, lastCol).End(xlUp).Row

                            'Подсчитываем, сколько строк должно остаться'
                            ActiveSheet.Range(Cells(6, lastCol), Cells(LastRow, lastCol)).Select
                            CountRow = WorksheetFunction.CountIf(Range(Cells(6, lastCol), Cells(LastRow, lastCol)), "<>0")

                            'Удаляем лишние строки (где Общая загруженность (%) = 0)'
                                For Q = 6 To 6 + CountRow Step 1
                                    If Cells(Q, lastCol) = 0 Then
                                        Rows(Q).Delete
                                        'Если все лишние нули удалены, то останавливаем цикл'
                                        If CountRowlastCol = CountRow Then
                                            Q = 6 + CountRow
                                        Else
                                        Q = Q - 1
                                        End If
                                    End If
                                'Подсчитываем, сколько строк сейчас в последнем столбце'
                                CountRowlastCol = WorksheetFunction.CountA(Range(Cells(6, lastCol), Cells(25, lastCol)))

                                Next Q

                            'Отправляем на предварительный просмотр перед печатью'
                            'Вписываем на 1 лист'
                            Application.PrintCommunication = False
                            ActiveSheet.PageSetup.FitToPagesWide = 1
                            Application.PrintCommunication = True
                            'Горизонтальная страница'
                            ActiveSheet.PageSetup.Orientation = xlLandscape
                            'Предпросмотр'
                            ActiveSheet.PrintPreview
                            'Отправляем на печать'
                            ActiveWorkbook.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
                            ActiveWindow.Close False
                            Windows("automatic-printing.xlsm").Activate

                            End If 'Закрываем проверку на наличие графика'
                    Next i 'Переходим к следующей дате'

                Else: s = s

                End If
            Next s

        'Очищаем фильтр'
        Range("Таблица1[[#Headers]]").Activate
        ActiveSheet.ShowAllData
        'Удаляем лишнее'
        Range("AT2:AT8").ClearContents
        Range("AS2:AS13") = False

        End If

    End Sub

Во второй модуль вставляем код:

Sub Sort()
        'Сортировкой по цвету (розовый) упорядочиваем строки от конца до начала'
        Rows("5:5").AutoFilter
        ActiveSheet.AutoFilter.Sort.SortFields.Clear
            ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("D6" _
            ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
            , 199, 206)
        ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("E6" _
            ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
            , 199, 206)
        ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("F6" _
            ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
            , 199, 206)
        ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("G6" _
            ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
            , 199, 206)
        ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("H6" _
            ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
            , 199, 206)
        ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("I6" _
            ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
            , 199, 206)
        ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("J6" _
            ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
            , 199, 206)
        ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("K6" _
            ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
            , 199, 206)
        ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("L6" _
            ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
            , 199, 206)
        ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("M6" _
            ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
            , 199, 206)
        ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("N6" _
            ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
            , 199, 206)
        ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("O6" _
            ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
            , 199, 206)
        ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("P6" _
            ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
            , 199, 206)
        ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("Q6" _
            ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
            , 199, 206)
        ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("R6" _
            ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
            , 199, 206)
        ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("S6" _
            ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
            , 199, 206)
        ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("T6" _
            ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
            , 199, 206)
        ActiveSheet.AutoFilter.Sort.SortFields.Add(Range("U6" _
            ), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = RGB(255 _
            , 199, 206)

        With ActiveSheet.AutoFilter.Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        Selection.AutoFilter
    End Sub

Сохраняем изменения. Последний штрих – создаем кнопку «Печать» и присваиваем ей макрос Filter.

Готово! Выбираем сотрудников, даты и жмем печать. График по каждому сотруднику генерируется автоматически и идет на печать. При необходимости все сменные графики можно сохранять в отдельной папке на вашем устройстве. Изменение структуры листа с графиком влечет за собой изменение в приложенном коде.

Заключение

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

Нужна помощь в Excel или Google Sheets? Свяжитесь с нами, обсудим все детали.

Оперативно решаем любую проблему в Excel и Google таблицах:

• Написание формул любой сложности
• Создание сводных таблиц
• Визуализация данных (диаграммы, гистограммы)
• Автоматизация расчётов и рутинных задач
• Консультации по работе с таблицами и многое другое

Также, у нас Вы можете пройти бесплатные онлайн курсы по MS Excel с заданиями

Опубликовано ср, 03/13/2019 — 09:20 пользователем JT

Категория: 

Программы в Excel

Условия распространения: 

Бесплатно

Версия: 

5

Цена: 

0руб.

Загрузить: 

Вложение	Размер
Календарный график	24.39 КБ

Лист в MS Excel для создания и оформления календарных графиков с подсчетом продолжительности работ и потребности в рабочих кадрах.
Достоинством данного графика является автоматическое «построение» полосок и заполнение количества рабочих для каждого вида работ.
В книге не использованы макросы, все сделано только при помощи формул.