Построение диаграммы на основе данных нескольких рабочих листов
В процессе работы нередко возникает необходимость в оперативной обработке данных, которые хранятся на нескольких рабочих листах. Как известно, одним из способов обработки информации является построение диаграмм. В этом разделе мы рассмотрим, каким образом можно построить одновременно несколько диаграмм, исходными данными для которых будет информация, расположенная на нескольких рабочих листах.
Предположим, что у нас имеются пять разных таблиц, которые расположены на пяти рабочих листах, причем количество строк в этих таблицах различается. Одна из таких таблиц показана на рис. 4.8.
Рис. 4.8. Пример таблицы
Для построения диаграмм на основании данных, хранящихся в этих таблицах, можно использовать макрос, код которого приведен в листинге 4.11.
Листинг 4.11. Одновременное создание нескольких диаграмм
Sub ManyCharts()
Dim intTop As Long, intLeft As Long
Dim intHeight As Long, intWidth As Long
Dim sheet As Worksheet
Dim lngFirstRow As Long ' Первая строка с данными
Dim intSerie As Integer ' Текущая категория диаграммы
Dim strErrorSheets As String ' Список листов, для которых _
не удалось построить диаграммы
intTop = 1 ' Верхняя точка первой диаграммы
intLeft = 1 ' Левая точка каждой диаграммы
intHeight = 180 ' Высота каждой диаграммы
intWidth = 300 ' Ширина каждой диаграммы
' Построение диаграммы для каждого листа, кроме текущего
For Each sheet In ActiveWorkbook.Worksheets
If sheet.Name <> ActiveSheet.Name Then
' Первый заполненный ряд
lngFirstRow = 3
' Первая категория
intSerie = 1
On Error GoTo DiagrammError
' Добавление и настройка диаграммы
With ActiveSheet.ChartObjects.Add _
(intLeft, intTop, intWidth, intHeight).Chart
Do Until IsEmpty(sheet.Cells(lngFirstRow + intSerie, 1))
' Создание ряда
.SeriesCollection.NewSeries
' Значения для ряда
.SeriesCollection(intSerie).Values = _
sheet.Range(sheet.Cells(lngFirstRow + intSerie, 2), _
sheet.Cells(lngFirstRow + intSerie, 4))
' Диапазон данных для подписей
.SeriesCollection(intSerie).XValues = _
sheet.Range(«B3:D3»)
' Название ряда (берется из столбца "A" таблицы
с данными)
.SeriesCollection(intSerie).Name = sheet.Cells( _
lngFirstRow + intSerie, 1)
intSerie = intSerie + 1
Loop
' Настройка внешнего вида диаграммы
.ChartType = xl3DColumnClustered
.ChartGroups(1).GapWidth = 20
.PlotArea.Interior.ColorIndex = xlNone
.ChartArea.Font.Size = 9
' Диаграмма с легендой
.HasLegend = True
' Заголовок
.HasTitle = True
.ChartTitle.Characters.Text = sheet.Range(«A1»)
' Задание диапазона значений на осях
.Axes(xlValue).MinimumScale = 0
.Axes(xlValue).MaximumScale = 120000
' Стиль линий сетки (прерывистый)
.Axes(xlValue).MajorGridlines.Border. _
LineStyle = xlDot
End With
On Error GoTo 0
' Сдвиг верхней точки следующей диаграммы на высоту _
текущей диаграммы
intTop = intTop + intHeight
AfterError:
End If
Next sheet
If strErrorSheets <> "" Then
' Отобразим список листов, для которых не построили диаграммы
MsgBox «Не удалось построить диаграммы для листов:» &
Chr(13) _
& strErrorSheets, vbExclamation
End If
Exit Sub
DiagrammError:
' Добавление в список имени листа, для которого не смогли _
построить диаграмму (ошибка в данных для диаграммы)
strErrorSheets = strErrorSheets & sheet.Name & Chr(13)
' Удаление пустой диаграммы на текущем листе
ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count).Delete
' Продолжаем работу с другими листами
Resume AfterError
End Sub
Перед запуском макроса нужно создать пустой рабочий лист для диаграмм. Макрос следует запускать, находясь на этом рабочем листе. В результате выполнения макроса будет создано сразу пять диаграмм, расположенных одна под другой, – по диаграмме для каждой таблицы. Диаграммам будут присвоены названия в соответствии со значением, хранящимся в ячейке А1 (например, на рис. 4.8 в данной ячейке хранится значение Таблица 4, поэтому и соответствующая ей диаграмма будет называться Таблица 4). Особо следует отметить, что приведенный макрос корректно обрабатывает данные в разных таблицах, несмотря на то что количество строк в них различается.