Алексей Гладкий - Excel. Трюки и эффекты

построить диаграмму (ошибка в данных для диаграммы)

strErrorSheets = strErrorSheets & sheet.Name & Chr(13)

' Удаление пустой диаграммы на текущем листе

ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count).Delete

' Продолжаем работу с другими листами

Resume AfterError

End Sub

Перед запуском макроса нужно создать пустой рабочий лист для диаграмм. Макрос следует запускать, находясь на этом рабочем листе. В результате выполнения макроса будет создано сразу пять диаграмм, расположенных одна под другой, – по диаграмме для каждой таблицы. Диаграммам будут присвоены названия в соответствии со значением, хранящимся в ячейке А1 (например, на рис. 4.8 в данной ячейке хранится значение Таблица 4, поэтому и соответствующая ей диаграмма будет называться Таблица 4). Особо следует отметить, что приведенный макрос корректно обрабатывает данные в разных таблицах, несмотря на то что количество строк в них различается.

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

Диаграмма, а также исходные данные, на основании которых она построена, приведены на рис. 4.9.

Рис. 4.9. Диаграмма без подписей

Для управления отображением подписями к точкам диаграммы нужно в стандартном модуле редактора VBА написать следующий код (листинг 4.12).

Sub ShowLabels()

Dim rgLabels As Range ' Диапазон с подписями

Dim chrChart As Chart ' Диаграмма

Dim intPoint As Integer ' Точка, для которой добавляется

подпись

' Определение диаграммы

Set chrChart = ActiveSheet.ChartObjects(1).Chart

' Запрос на ввод диапазона с исходными данными

On Error Resume Next

Set rgLabels = Application.InputBox _

(prompt:="Укажите диапазон с подписями", Type:=8)

If rgLabels Is Nothing Then Exit Sub

On Error GoTo 0

' Добавление подписей

chrChart.SeriesCollection(1).ApplyDataLabels _

Type:=xlDataLabelsShowValue, _

AutoText:=True, _

LegendKey:=False

' Просмотр диапазона и назначение подписей

For intPoint = 1 To chrChart.SeriesCollection(1).Points.Count

chrChart.SeriesCollection(1). _

Points(intPoint).DataLabel.Text = rgLabels(intPoint)

Next intPoint

End Sub

Sub DeleteLabels()

' Удаление подписей диаграммы

ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1). _

HasDataLabels = False

End Sub

В результате написания данного кода будут созданы два макроса: ShowLabels (для включения подписей) и DeleteLabels (для их выключения). После выполнения макроса ShowLabels откроется диалоговое окно, в котором нужно указать диапазон исходных данных для создания подписей.

На рис. 4.10 показана диаграмма с подписями.

Рис. 4.10. Диаграмма с подписями

В данном случае в качестве исходных данных для создания подписей был использован диапазон А2:А9.

В данной главе приведено несколько конкретных примеров создания приложений для дальнейшего их использования в Microsoft Excel.

В этом разделе мы рассмотрим, каким образом, используя механизм пользовательских форм и механизм макросов, можно создать программу для быстрого составления кроссвордов.

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

Const dhcMinCol = 1 ' Номер первого столбца кроссворда

Const dhcMaxCol = 35 ' Номер последнего столбца кроссворда

Const dhcMinRow = 1 ' Номер первой строки кроссворда

Const dhcMaxRow = 35 ' Номер последней строки кроссворда

Sub Clear()

' Выделение и очистка всех используемых для кроссворда ячеек

Range(Cells(dhcMinRow, dhcMinCol), _

Cells(dhcMaxRow, dhcMaxCol)).Select

Selection.Clear

' Удаление сетки всего кроссворда

ClearGrid

Range(«A1»).Select

End Sub

Sub ClearGrid()

' Удаление сетки кроссворда (в выделенных ячейках)...

' Возврат прежнего цвета ячеек

Selection.Interior.ColorIndex = xlNone

' Задание начертания границ ячеек по умолчанию

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

Selection.Borders(xlEdgeLeft).LineStyle = xlNone

Selection.Borders(xlEdgeTop).LineStyle = xlNone

Selection.Borders(xlEdgeBottom).LineStyle = xlNone

Selection.Borders(xlEdgeRight).LineStyle = xlNone