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

 

Программное создание графика (диаграммы) в VBA Excel с помощью метода Charts.Add на основе данных из диапазона ячеек на рабочем листе. Примеры.

Метод Charts.Add

В настоящее время на сайте разработчиков описывается метод Charts.Add2, который, очевидно, заменил метод Charts.Add. Тесты показали, что Charts.Add продолжает работать в новых версиях VBA Excel, поэтому в примерах используется именно он.

Синтаксис

Charts.Add ([Before], [After], [Count])

Charts.Add2 ([Before], [After], [Count], [NewLayout])

Параметры

Параметры методов Charts.Add и Charts.Add2:

Параметр	Описание
Before	Имя листа, перед которым добавляется новый лист с диаграммой. Необязательный параметр.
After	Имя листа, после которого добавляется новый лист с диаграммой. Необязательный параметр.
Count	Количество добавляемых листов с диаграммой. Значение по умолчанию – 1. Необязательный параметр.
NewLayout	Если NewLayout имеет значение True, диаграмма вставляется с использованием новых правил динамического форматирования (заголовок имеет значение «включено», а условные обозначения – только при наличии нескольких рядов). Необязательный параметр.

Если параметры Before и After опущены, новый лист с диаграммой вставляется перед активным листом.

Примеры

Таблицы

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

Пример 1

Программное создание объекта Chart с типом графика по умолчанию и по исходным данным из диапазона «A2:B26»:

Sub Primer1() Dim myChart As Chart ‘создаем объект Chart с расположением нового листа по умолчанию Set myChart = ThisWorkbook.Charts.Add     With myChart         ‘назначаем объекту Chart источник данных         .SetSourceData (Sheets(«Лист1»).Range(«A2:B26»))         ‘переносим диаграмму на «Лист1» (отдельный лист диаграммы удаляется)         .Location xlLocationAsObject, «Лист1»     End With End Sub

Результат работы кода VBA Excel из первого примера:

Пример 2

Программное создание объекта Chart с двумя линейными графиками по исходным данным из диапазона «A2:C26»:

Sub Primer2() Dim myChart As Chart Set myChart = ThisWorkbook.Charts.Add     With myChart         .SetSourceData (Sheets(«Лист1»).Range(«A2:C26»))         ‘задаем тип диаграммы (линейный график с маркерами)         .ChartType = xlLineMarkers         .Location xlLocationAsObject, «Лист1»     End With End Sub

Результат работы кода VBA Excel из второго примера:

Пример 3

Программное создание объекта Chart с круговой диаграммой, разделенной на сектора, по исходным данным из диапазона «E2:F7»:

Sub Primer3() Dim myChart As Chart Set myChart = ThisWorkbook.Charts.Add     With myChart         .SetSourceData (Sheets(«Лист1»).Range(«E2:F7»))         ‘задаем тип диаграммы (пирог — круг, разделенный на сектора)         .ChartType = xlPie         ‘задаем стиль диаграммы (с отображением процентов)         .ChartStyle = 261         .Location xlLocationAsObject, «Лист1»     End With End Sub

Результат работы кода VBA Excel из третьего примера:

Примечание

В примерах использовались следующие методы и свойства объекта Chart:

Компонент	Описание
Метод SetSourceData	Задает диапазон исходных данных для диаграммы.
Метод Location	Перемещает диаграмму в заданное расположение (новый лист, существующий лист, элемент управления).
Свойство ChartType	Возвращает или задает тип диаграммы. Смотрите константы.
Свойство ChartStyle	Возвращает или задает стиль диаграммы. Значение нужного стиля можно узнать, записав макрос.

---

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

Введение

Мы решили сделать обзорное видео и показать Вам один из вариантов настройки автоматической печати рабочего графика в 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