Эффект прозрачности диаграммы

Применение случайной цветовой палитры

Листинг 5.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

Листинг 5.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

' Вставляем автофигуру в изображения столбцов _

категории и настраиваем

With srSerie

' Собственно вставка

.Paste

' Возвращаем на место толщину линий

.Border.Weight = intBorderWeight

' Стиль линий

.Border.LineStyle = intBorderLineStyle

' Цвет границы

.Border.ColorIndex = intBorderColorIndex

End With

' Автофигура больше не нужна

shpShape.Delete

End If

Next srSerie

End Sub

Дата добавления: 2015-06-25