' Формирование списка диаграмм
For Each crt In ActiveWorkbook.Charts
strMessage = strMessage & crt.Name & vbNewLine
Next
' Отображение списка
MsgBox strMessage
End Sub
После применения данного макроса появится окно с перечнем рабочих листов текущей книги, содержащих диаграммы.
Применение случайной цветовой палитры
Рассматриваемый в данном разделе трюк носит чисто эргономический характер. С его помощью можно при работе с внедренными диаграммами применять совершенно случайные цвета заливки элементов диаграммы.
Для получения эффекта случайной цветовой палитры можно использовать следующий макрос (листинг 4.9).
Sub RandomChartColors()
Dim intGradientStyle As Integer, intGradientVariant As
Integer
Dim i As Integer
' Проверка, выделена ли диаграмма
If ActiveChart Is Nothing Then Exit Sub
' Изменение оформления всех категорий
For i = 1 To ActiveChart.SeriesCollection.Count
With ActiveChart.SeriesCollection(i)
' Вид градиентной заливки (случайный)
intGradientStyle = Int(Rnd * 7) + 1
If intGradientStyle = 6 Then intGradientStyle = 1
If intGradientStyle = 7 Then
intGradientVariant = Int(Rnd * 2) + 1
Else
intGradientVariant = Int(Rnd * 4) + 1
End If
' Применение градиента
.Fill.TwoColorGradient Style:=intGradientStyle, _
Variant:=intGradientVariant
' Установка случайных цветов фона и обводки (используются _
для градиента)
.Fill.ForeColor.SchemeColor = Int(Rnd * 57) + 1
.Fill.BackColor.SchemeColor = Int(Rnd * 57) + 1
End With
Next i
End Sub
Чтобы изменить цветовую палитру диаграммы, необходимо выделить ее и запустить данный макрос.
Эффект прозрачности диаграммы
С помощью несложного трюка можно сделать так, что диаграмма будет прозрачной. Для этого применим, например, такой макрос (листинг 4.10).
Sub TransparentChart()
Dim shpShape As Shape
Dim dblColor As Double
Dim srSerie As Series
Dim intBorderLineStyle As Integer
Dim intBorderColorIndex As Integer
Dim intBorderWeight As Integer
' Проверка, есть ли выделенная диаграмма
If ActiveChart Is Nothing Then Exit Sub
' Изменение отображения каждой категории
For Each srSerie In ActiveChart.SeriesCollection
If (srSerie.ChartType = xlColumnClustered Or _
srSerie.ChartType = xlColumnStacked Or _
srSerie.ChartType = xlColumnStacked100 Or _
srSerie.ChartType = xlBarClustered Or _
srSerie.ChartType = xlBarStacked Or _
srSerie.ChartType = xlBarStacked100) Then
' Сохранение прежнего цвета категории
dblColor = srSerie.Interior.Color
' Сохранение стиля линий
intBorderLineStyle = srSerie.Border.LineStyle
' Цвет границы
intBorderColorIndex = srSerie.Border.ColorIndex
' Толщина линий границы
intBorderWeight = srSerie.Border.Weight
' Создание автофигуры
Set shpShape = ActiveSheet.shapes.AddShape _
(msoShapeRectangle, 1, 1, 100, 100)
With shpShape
' Закрашиваем нужным цветом
.Fill.ForeColor.RGB = dblColor
' Делаем прозрачной
.Fill.Transparency = 0.4
' Убираем линии
.Line.Visible = msoFalse
End With
' Копируем автофигуру в буфер обмена
shpShape.CopyPicture Appearance:=xlScreen, _
Format:=xlPicture
' Вставляем автофигуру в изображения столбцов _