Microsoft Excel:

  Таблицы и VBA. Справочник.
  Вопросы и Ответы. Советы. Примеры.
Меню FAQ | Макросы | Диаграмма


Rambler's Top100


Counter CO.KZ


    [1] [2] [3]

  1. Как создать лист диаграммы ? 02.05.2007
  2. Как удалить сразу все листы диаграмм ? 02.05.2007
  3. Как удалить сразу все диаграммы, расположенные на рабочем листе ? 12.10.2016
  4. Как создать рабочую книгу с одним единственным листом диаграммы ? 09.03.2011
  5. Как создать событие для диаграммы, расположенной на рабочем листе ? 17.07.2007
  6. Как распечатать все диаграммы в нужном рабочем листе ? 12.12.2006
  7. Как программно вращать об'ёмную круговую диаграмму ? 16.12.2006
  8. Как программно создать заголовок для диаграммы с несколькими рядами ? 16.12.2006
  9. Как программно обновить уже построенную диаграмму, а при необходимости и скрыть ? 30.04.2007
  10. Как программно узнать имя диаграммы, расположенной на рабочем листе ? 04.09.2016
  11. Как программно переместить диаграмму из одного рабочего листа в другой ? 30.08.2016
  12. Как сохранить диаграмму в виде .pdf файла ? 04.09.2016
  13. Как экспортировать диаграмму в графический файл ? 24.09.2006
  14. Как используя стандартное контекстное меню сохранить выбранную диаграмму в графический файл ? 04.02.2007
  15. Как сохранить все диаграммы, расположенные на листах диаграмм, в нужную папку в виде графических файлов ? 09.01.2007
  16. Как сохранить все диаграммы в папку, где расположена книга, в виде графических файлов ? 09.01.2007
  17. Как определить выделена(активна) диаграмма или нет ? 30.09.2016
  18. Как сохранить любой рисунок в виде графического файла ? 17.06.2016
  19. Как программно импортировать нужный рисунок ? 07.10.2007
  20. Как импортировать нужный рисунок из интернета ? 20.05.2016
  21. Как импортировать все(или только определённого типа) картинки из выбранной папки ? 01.11.2014
  22. Как определить ячейки, к которым привязан графический об'ект ? 08.04.2011
  23. Как определить "пересекаются" или нет графические об'екты с конкретным диапазоном ? 09.05.2016
  24. Как создать копию графического об'екта и разместить его в нужном месте рабочего листа ? 24.05.2008
  25. Как скопировать формат одного графического об'екта и применить его к другим об'ектам (тиражирование формата) ? 24.06.2008
  26. Как удалить все графические об'екты в рабочем листе [без цикла] ? 24.09.2006
  27. Как назначить макрос всем графическим об'ектам одного типа [без цикла] ? NEW 15.10.2017
  28. Как перебрать все графические об'екты расположенные в нужном рабочем листе ? 26.02.2007
  29. Как перебрать в цикле только OLEObject ? 26.02.2007
  30. Как узнать имя Shape вызвавшего макрос ? 26.01.2007
  31. Как определить принадлежность Shape к группе ? 26.01.2007
  32. Как менять цвет заливки автофигуры в зависимости от данных ячейки ? 17.12.2006
  33. Как менять цвет заливки автофигуры в зависимости от дня недели ? 21.06.2007
  34. Как создать всплывающую подсказку для графических об'ектов ? 05.05.2007
  35. Как создать всплывающие подсказки для нужных ячеек ? 03.07.2007
    [1] [2] [3]


  • Ответ :

    Вариант I.
  • ThisWorkbook.Charts.Add
    Вариант II.
    ThisWorkbook.Sheets.Add Type:=xlChart
    Комментарий : Нельзя добавить лист диаграммы, если структура рабочей книги защищена [FAQ]
  • Ответ :
  • Application.DisplayAlerts = False
    ThisWorkbook.Charts.Delete
    Application.DisplayAlerts = True
    With Application
         .DisplayAlerts = False
         .ThisWorkbook.Charts.Delete
         .DisplayAlerts = True
    End With
    Комментарий :
  • - Если у всех листов диаграмм, которые Вы планируете удалить, значение свойства Visible = xlVeryHidden/xlSheetVeryHidden, то попытка их удаления приведёт к ошибке. В противном случае, будут удалены только видимые листы, а также листы, у которых свойство Visible имеет значение xlSheetHidden
  • - После удаления листов, в рабочей книге должен остаться, как минимум, один видимый лист (вне зависимости от типа)
  • - Нельзя удалить листы, если рабочая книга является общей
  • - Нельзя удалить листы, если структура рабочей книги защищена [FAQ]
  • Ответ :

    Для того, чтобы удалить сразу все диаграммы, расположенные на рабочем листе, можно использовать метод Delete об'екта ChartObjects
  • Worksheets(1).ChartObjects.Delete
    Особенности Microsoft Excel 95-2003 Когда рабочий лист защищён в отношении об'ектов, то удаления диаграмм не происходит и никакой ошибки не возникает. Причём не важно, защищены или нет диаграммы.

    Особенности Microsoft Excel 2007

  • В этой версии возникает ошибка 1004, если диаграммы на листе изволят отсутствовать. Чтобы избежать этой ошибки, достаточно предварительно проверить их наличие, т.е.
  • With Worksheets(1).ChartObjects
         If .Count > 0 Then .Delete
    End With
    или
    If Worksheets(1).ChartObjects.Count > 0 Then Worksheets(1).ChartObjects.Delete
  • Кроме того, ошибка возникнет, если рабочий лист защищён в отношении об'ектов, т.е. в отличии от старых версий, здесь, чтобы удалить сразу все диаграммы, без использовании On Error Resume Next
  • With Worksheets(1).ChartObjects
         If Not .Parent.ProtectDrawingObjects _
         Then If .Count > 0 Then .Delete
    End With

  • Ответ : Скачать пример Актуально для MS Excel 97, 2000, XP

    Для того, чтобы после активации нужного рабочего листа, Вы могли использовать события диаграммы, которая будет расположена в активном рабочем листе, достаточно разместить в модуле этого листа следующий код :
  • Private WithEvents ChartObject As Excel.Chart

    Private Sub Worksheet_Activate()
        Set ChartObject = Me.ChartObjects(1).Chart
        'Укажите существующей индекс(номер) или имя нужной диаграммы
    End Sub
    Теперь, Вы можете создать нужное событие диаграммы : для этого в окне программы [F7] в первом поле со списком нужно выбрать ChartObject, а во втором поле выбрать нужное событие.

    Комментарий : Вместо события рабочего листа Worksheet_Activate() можно использовать событие рабочей книги Worksheet_Open() (вкупе с соответствующими изменениями)
  • Ответ :
  • Private Sub ChartObjects_PrintOut()
        For iCount& = 1 To Worksheets(1).ChartObjects.Count
            Worksheets(1).ChartObjects(iCount&).Chart.PrintOut
        Next
    End Sub
    Private Sub ChartObjects_PrintOut2()
        With Worksheets(1).ChartObjects
             For iCount& = 1 To .Count
                 .Item(iCount&).Chart.PrintOut
             Next
        End With
    End Sub
    Private Sub ChartObjects_PrintOut3()
        Dim iCharts As ChartObjects
        Set iCharts = Worksheets(1).ChartObjects
        For iCount& = 1 To iCharts.Count
            iCharts(iCount&).Chart.PrintOut
        Next
    End Sub

  • Ответ : Скачать пример

    Для поворота диаграммы используется свойство Rotation об'екта Chart.
  • Private Sub ChartRotation()
        If Me.ChartObjects.Count = 0 Then
           MsgBox "В рабочем листе " & Me.Name & " нет диаграммы", vbCritical, ""
           Exit Sub
        End If
        If Me.ChartObjects(1).Locked = True And _
           Me.ProtectDrawingObjects = True Then
           MsgBox "Изменение защищённой диаграммы невозможно", vbCritical, ""
           Exit Sub
        End If
        If Me.ChartObjects(1).Chart.ChartType = xl3DPie Then
           Me.ChartObjects(1).Chart.Rotation = Me.ScrollBars(1).Value
        End If
    End Sub
    В этом примере используется элемент управления Полоса прокрутки с панели инструментов Формы. Минимальное значение которого = 0, максимальное значение = 360. Данный код необходимо разместить в модуле рабочего листа, где находится об'ёмная круговая диаграмма.

    Примечание : В MS Excel 95 этот код нужно разместить в стандартном модуле, заменив ключевое слово Me ссылкой на нужный рабочий лист. В следующих версиях также возможно использование стандартных модулей, но в отличии от версии 7.0 это не является обязательным условием.
  • Ответ : Скачать пример

    Для того, чтобы отобразить заголовок, а затем изменить его текст, используются свойства HasTitle и ChartTitle об'екта Chart. А для создания названия диаграммы используются имена рядов, т.е. свойство Name для каждого об'екта в семействе SeriesCollection.
  • Private Sub ChartObject_Title()
        If Me.ChartObjects.Count = 0 Then
           MsgBox "В рабочем листе " & Me.Name & " нет диаграммы", vbCritical, ""
           Exit Sub
        End If
        If Me.ChartObjects(1).Locked = True And _
           Me.ProtectDrawingObjects = True Then
           MsgBox "Изменение заголовка диаграммы невозможно", vbCritical, ""
           Exit Sub
        End If
        With Me.ChartObjects(1).Chart
             If .SeriesCollection.Count = 0 Then
                MsgBox "Диаграмма не содержит ни одного ряда", vbCritical, ""
                Exit Sub
             End If
             If Me.CheckBoxes(1).Value = xlOn Then
                For iCount& = 1 To .SeriesCollection.Count
                    iTitle$ = iTitle$ & ";" & .SeriesCollection(iCount&).Name
                Next
                .HasTitle = True
                .ChartTitle.Caption = Mid(iTitle$, 2)
                .ChartTitle.Font.Size = 8 'Необязательно
             Else
                .HasTitle = False
             End If
        End With
    End Sub
    В этом примере используется элемент управления Флажок с панели инструментов Формы, который отвечает за отображение или скрытие заголовка диаграммы. Данный код необходимо разместить в модуле рабочего листа, где находится нужная диаграмма.

    Примечание : [См. выше]
  • Ответ : Скачать пример Актуально для MS Excel 97, 2000, XP

    Для того, чтобы по мере необходимости, например, перед печатью листа, обновить уже имеющеюся диаграмму (в данном примере) используется метод SetSourceData об'екта Chart. Впрочем, можно также воспользоваться методом ChartWizard. За видимость же об'екта, отвечает свойство Visible.
  • Private Sub Update_Chart()
        If Me.ChartObjects.Count = 0 Then
           MsgBox "В рабочем листе " & Me.Name & " нет диаграммы", vbCritical, ""
           Exit Sub
        End If
        If Me.ProtectContents = True Or _
           Me.ProtectDrawingObjects = True Then
           MsgBox "Изменение в защищённом листе нежелательно", vbCritical, ""
           Exit Sub
        End If
        Me.ChartObjects(1).Chart.SetSourceData Source:= _
        Me.Range("A1").CurrentRegion, PlotBy:=xlColumns
    End Sub

    Private Sub Visible_Chart()
        If Me.ChartObjects.Count = 0 Then
           MsgBox "В рабочем листе " & Me.Name & " нет диаграммы", vbCritical, ""
           Exit Sub
        End If
        Me.ChartObjects(1).Visible = Not Me.ChartObjects(1).Visible
    End Sub
    В этом примере используется два графических об'екта, один из которых отвечает за отображение обновление диаграммы, а другой, за скрытие/отображение этой диаграммы. Кроме того, предполагается, что диаграмма построена на основании диапазона, начинающегося с ячейки "A1" Данный код необходимо разместить в модуле рабочего листа, где находится нужная диаграмма.

    Комментарий : Если используются события, типа Worksheet_SelectionChange() и т.п., то перед использованием свойства CurrentRegion желательно блокировать выполнение этих событий [FAQ157]
  • Ответ :

    Для того, чтобы с помощью VBA узнать имя существующей диаграммы, расположенной в рабочем листе, можно использовать :

    - свойство Name об'екта ChartObject. В этом случае мы получим только имя диаграммы.
  • MsgBox Worksheets(1).ChartObjects(1).Name
    MsgBox Worksheets("Лист1").ChartObjects(1).Name
    - свойство Name об'екта Chart. В этом случае мы получим имя, включающее в себя ещё и имя рабочего листа, где находится диаграмма. Например, "Лист1 Диагр. 1" или "Лист1 Chart 1"
    MsgBox Worksheets(1).ChartObjects(1).Chart.Name
    MsgBox Worksheets("Лист1").ChartObjects(1).Chart.Name

  • Ответ :

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

    Вариант I. Используем метод Location об'екта Chart. Обратите внимание на то, что лист-приёмник, это не об'ект, а просто имя листа, т.е. строка.
  • Worksheets("Лист1").ChartObjects(1).Chart.Location xlLocationAsObject, "Лист3"
    Если мы не знаем имя рабочего листа, куда необходимо переместить диаграмму, то :
    Worksheets(1).ChartObjects(1).Chart.Location xlLocationAsObject, Worksheets(3).Name
    Если после перемещения, нужно изменить месторасположение диаграммы, а также изменить её размер, то в этом случае, можно воспользоваться соответствующими свойствами, т.е. :
    With Worksheets("Лист1").ChartObjects(1).Chart.Location(xlLocationAsObject, "Лист3").Parent
         .Left = 0
         .Top = 0
         '.Width = .Width / 2
         '.Height = .Height / 2
    End With
    Dim iChart As Chart
    Set iChart = Worksheets("Лист1").ChartObjects(1).Chart
    Set iChart = iChart.Location(xlLocationAsObject, "Лист3")

    With iChart.Parent
         .Left = 0
         .Top = 0
         '.Width = 25
         '.Height = 50
    End With
    Dim iChart As ChartObject
    Set iChart = Worksheets("Лист1").ChartObjects(1)
    Set iChart = iChart.Chart.Location(xlLocationAsObject, "Лист3").Parent

    iChart.Left = 0
    iChart.Top = 0
    'iChart.Width = 25
    'iChart.Height = 50
    Вариант II. Используем возможности VBA, аналогичные командам Вырезать и Вставить
    Worksheets(1).ChartObjects(1).Cut
    Worksheets(3).Paste
    Если после перемещения, нужно изменить месторасположение диаграммы, то можно указать ячейку, к которой нам надо "привязать" перемещаемую диаграмму :
    Worksheets(1).ChartObjects(1).Cut
    Worksheets(3).Paste Worksheets(3).Range("A1")
    Если же ячейка не должна служить "якорем", и/или нам необходимо изменить ещё и размеры диаграммы, то :
    Worksheets(1).ChartObjects(1).Cut
    With Worksheets(3)
         .Paste
         With .ChartObjects(.ChartObjects.Count)
              .Left = 0
              .Top = 0
              '.Width = .Width / 2
              '.Height = .Height / 2
         End With
    End With

  • Ответ : Актуально для MS Excel 2007

    Для того, чтобы сохранить существующую диаграмму в виде .PDF файла, можно применить метод ExportAsFixedFormat.

    Если диаграмма расположена в рабочем листе, то :
  • ThisWorkbook.Worksheets(1).ChartObjects(1).Chart.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Диграмма1.pdf"
    Если диаграмма представляет собой отдельный лист, то :
    ThisWorkbook.Charts(1).ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Диграмма2.pdf"
    Примечание : Имейте ввиду, что впервые метод ExportAsFixedFormat появился только в Excel 2007, причём в этой версии, в отличии от последующих, чтобы им воспользоваться, необходимо предварительно установить надстройку от Microsoft. Найти и скачать этот файл SaveAsPDFandXPS.exe , который, собственно, и предназначен для установки дополнения, можно по адресу :

    2007 Microsoft Office Add-in: Microsoft Save as PDF or XPS


  • Ответ : Скачать пример Актуально для MS Excel 97, 2000, XP

    Если диаграмма расположена в рабочем листе, то :
  • iThisPath = ThisWorkbook.Path
    iFileName = "ChartPicture.gif"

    ThisWorkbook.Worksheets(1).ChartObjects(1).Chart.Export _
    FileName:=iThisPath & "\" & iFileName, FilterName:="GIF"
    Если диаграмма представляет собой отдельный лист, то :
    iThisPath = ThisWorkbook.Path
    iFileName = "ChartPicture.gif"

    ThisWorkbook.Charts(1).Export _
    FileName:=iThisPath & "\" & iFileName, FilterName:="GIF"

  • Ответ : Актуально для MS Excel 97, 2000, XP

    Для того, чтобы после выделения области диаграммы или области построения и клика правой кнопкой мышки, в контекстном меню появилась команда, позволяющая сохранить диаграмму в виде графического файла скопируйте оба макроса и расположите их в любом стандартном модуле личной книги макросов "Personal.xls"
  • Private Sub Auto_Open()
        For Each iBarName In Array("Object/Plot", "Plot Area")
            With Application.CommandBars(iBarName)
                 .Enabled = True
                 .Protection = msoBarNoProtection
                 With .Controls.Add(Type:=msoControlButton, Temporary:=True)
                      .BeginGroup = True
                      .FaceId = 956
                      .Caption = "Экспорт диаграммы"
                      .OnAction = "ChartExport"
                 End With
            End With
        Next
    End Sub

    Private Sub ChartExport()
        iFileName = Application.GetSaveAsFilename( _
        InitialFileName:="Chart", _
        FileFilter:="Формат GIF (*.gif),*gif,Формат JPG (*.jpg),*jpg", _
        Title:="Выберите нужную папку и введите необходимое имя файла")
        If iFileName <> False Then
           ActiveChart.Export FileName:=iFileName, FilterName:=Right(iFileName, 3)
        Else
           MsgBox "Необходимо было указать местосохранение диаграммы", vbCritical, ""
        End If
    End Sub
    Примечание :
  • - Использование свойств Enabled и Protection не носит обязательного характера, но имеет смысл, если контекстное меню могло быть предварительно заблокировано .Enabled = False и/или если меню могло быть защищено от изменений .Protection = msoBarNoCustomize
  • Ответ : Актуально для MS Excel 97, 2000, XP
  • Private Sub ExportAllChart()
        iPath$ = "C:\Диаграммы" 'Or "C:\Диаграммы\"
        'Здесь укажите свою папку для сохранения диаграмм

        If Dir(iPath$, vbDirectory) = "" Then
           MsgBox "Указанная папка " & iPath$ & vbNewLine & _
           "была удалена, перемещена или переименована ", vbExclamation, ""
           Exit Sub
        End If

        If Right(iPath$, 1) <> "\" Then iPath$ = iPath$ & "\"
        'Если при указании папки обязательно использовать PathSeparator
        'в конце пути, то эту строку можно убрать

        Dim iChart As Chart
        For Each iChart In ThisWorkbook.Charts
           iChart.Export _
           FileName:=iPath$ & iChart.Name & ".gif", FilterName:="GIF"
        Next
    End Sub

  • Ответ : Скачать пример Актуально для MS Excel 97, 2000, XP
  • Private Sub ExportAllCharts()
        iPath$ = ThisWorkbook.Path & "\"

        Dim iSheet As Object
        For Each iSheet In ThisWorkbook.Sheets
            Select Case TypeName(iSheet)
                Case "Chart"
                      iFileName$ = iPath$ & iSheet.Name & ".gif"
                      iSheet.Export FileName:=iFileName$, FilterName:="GIF"
                Case "Worksheet"
                      For iCount& = 1 To iSheet.ChartObjects.Count
                          iFileName$ = iPath$ & iSheet.Name & iCount& & ".gif"
                          iSheet.ChartObjects(iCount&).Chart.Export _
                          FileName:=iFileName$, FilterName:="GIF"
                      Next
            End Select
        Next
    End Sub

  • Ответ :

    Для того, чтобы определить, выделена(активна) диаграмма, или нет, можно использовать такой вариант :
  • If Not ActiveChart Is Nothing Then
       MsgBox "Сейчас выделена(активна) диаграмма " & ActiveChart.Name
    Else
       MsgBox "Сейчас нет выделенной диаграммы"
    End If
    If ActiveChart Is Nothing Then
       MsgBox "Сейчас нет выделенной диаграммы"
    Else
       MsgBox "Сейчас выделена(активна) диаграмма " & ActiveChart.Name
    End If
    Комментарий : VB(A) функция MsgBox и имя диаграммы, используются только для наглядности. В реальности, если Вам необходимо будет обратиться к активной диаграмме, то просто имейте ввиду, что ActiveChart это об'ект Chart. И чтобы понятней было о чём идёт речь, прилагается небольшой пример изменения текста в заголовке активной диаграммы. Если же активная диаграмма не имеет заголовка, то после выполнения нижеопубликованного макроса, он появится автоматически.
    Private Sub SetTextChartTitle()
        If ActiveChart Is Nothing Then Exit Sub
        
        With ActiveChart
             .HasTitle = True
             .ChartTitle.Caption = "Время " & Time
        End With
    End Sub

  • Ответ :

    Как сохранить любой рисунок в виде графического файла ? 17.06.2016
  • Ответ :

    Как программно импортировать нужный рисунок ? 07.10.2007
  • Ответ :

    Как импортировать нужный рисунок из интернета ? 20.05.2016
  • Ответ :

    Как определить ячейки, к которым привязан графический об'ект ? 08.04.2011
  • Ответ :

    Как определить "пересекаются" или нет графические об'екты с конкретным диапазоном ? 09.05.2016
  • Ответ :

    Как создать копию графического об'екта и разместить его в нужном месте рабочего листа ? 24.05.2008
  • Ответ :

    Как скопировать формат одного графического об'екта и применить его к другим об'ектам (тиражирование формата) ? 24.06.2008
  • Ответ :

    Как удалить все графические об'екты в рабочем листе [без цикла] ? 24.09.2006
  • Ответ :

    Как назначить макрос всем графическим об'ектам одного типа [без цикла] ? 15.10.2017
  • Ответ :

    Как перебрать все графические об'екты расположенные в нужном рабочем листе ? 26.02.2007
  • Ответ :

    Как перебрать в цикле только OLEObject ? 26.02.2007
  • Ответ :

    Как узнать имя Shape вызвавшего макрос ? 26.01.2007
  • Ответ :

    Как определить принадлежность Shape к группе ? 26.01.2007
  • Ответ :

    Как менять цвет заливки автофигуры в зависимости от данных ячейки ? 17.12.2006
  • Ответ :

    Как менять цвет заливки автофигуры в зависимости от дня недели ? 21.06.2007
  • Ответ :

    Как создать всплывающую подсказку для графических об'ектов ? 05.05.2007


    Воспроизведение любых опубликованных здесь материалов возможно только с письменного разрешения автора : Microsoft Excel 95, 97, 2000, XP

  • © 2004-2017 Климов П.Ю. Все права защищены. WebDesign & Error's Klimoff