Вывод списка диаграмм в отдельном окне

Построение и удаление диаграммы нажатием одной кнопки

Сохранение диаграммы в отдельном файле

Листинг 5.4. Сохранение диаграммы

Sub SaveChart()

' Сохранение выделенной диаграммы в файл

If ActiveChart Is Nothing Then

' Нет выделенных диаграмм

MsgBox "Выделите диаграмму"

Else

' Сохранение...

ActiveChart.Export ActiveWorkbook.path & "\Диаграмма.gif", "GIF"

End If

End Sub

Листинг 5.5. Сохранение диаграммы под указанным именем

Sub InteractiveSaveChart()

Dim strFileName As String ' Имя файла для сохранения

' Проверка, выделена ли диаграмма

If ActiveChart Is Nothing Then

' Нет выделенных диаграмм

MsgBox "Выделите диаграмму"

Else

' Выбор файла для сохранения

strFileName = Application.GetSaveAsFilename(_

ActiveChart.Name & ".gif", "Файлы GIF (*.gif), *.gif", 1, _

"Сохранить диаграмму в формате GIF")

' Проверка, выбран ли файл

If strFileName <> "" Then

' Сохранение выделенной диаграммы в файл

ActiveChart.Export strFileName, "GIF"

End If

End If

End Sub

Листинг 5.6. Быстрое построение и удаление диаграммы

Sub CreateChart()

' Создание диаграммы

Charts.Add

' Параметры диаграммы

' Тип диаграммы

ActiveChart.ChartType = xlLineMarkers

' Заголовок

ActiveChart.SetSourceData Range("B1:E2"), xlRows

ActiveChart.Location xlLocationAsObject, Name

' Остальные параметры

With ActiveChart

' Заголовок

.HasTitle = True

.ChartTitle.Characters.Text = Name

' Заголовок оси категорий

.Axes(xlCategory, xlPrimary).HasTitle = True

.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text _

= Sheets(Name).Range("A1").Value

' Заголовок оси значений

.Axes(xlValue, xlPrimary).HasTitle = True

.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text _

= Sheets(Name).Range("A2").Value

' Отображение легенды

.HasLegend = False

.HasDataTable = True

.DataTable.ShowLegendKey = True

' Настройка отображения сетки

With.Axes(xlCategory)

.HasMajorGridlines = True

.HasMinorGridlines = False

End With

With.Axes(xlValue)

.HasMajorGridlines = True

.HasMinorGridlines = False

End With

End With

End Sub

Sub DeleteChart()

' Удаление диаграммы

ActiveSheet.ChartObjects.Delete

End Sub

Листинг 5.7. Внедренные диаграммы

Sub ShowSheetCharts()

Dim strMessage As String

Dim i As Integer

' Формирование списка диаграмм

For i = 1 To ActiveSheet.ChartObjects.Count

strMessage = strMessage & ActiveSheet.ChartObjects(i).Name _

& vbNewLine

Next i

' Отображение списка

MsgBox strMessage

End Sub

Листинг 5.8. Перечень рабочих листов, содержащих обычные диаграммы

Sub ShowBookCharts()

Dim crt As chart

Dim strMessage As String

' Формирование списка диаграмм

For Each crt In ActiveWorkbook.Charts

strMessage = strMessage & crt.Name & vbNewLine

Next

' Отображение списка

MsgBox strMessage

End Sub

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