Microsoft Excel:

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


Rambler's Top100


Counter CO.KZ


    [1] [2] [3] [4]

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


  • Ответ :

    Вариант I.
  • ThisWorkbook.Charts.Add
    Вариант II.
    ThisWorkbook.Sheets.Add Type:=xlChart
    Комментарий : Нельзя добавить лист диаграммы, если структура рабочей книги защищена [FAQ]
  • Ответ :

    Для того, чтобы сразу создать диаграмму, расположенную на рабочем листе, можно использовать метод Add об'екта ChartObjects. Только обратите внимание на то, что данный метод имеет четыре обязательных аргумента и он создаёт пустую диаграмму, которую Вам предстоит в дальнейшем "заполнить"
  • Worksheets(1).ChartObjects.Add Left:=10, Top:=20, Width:=400, Height:=200
    
    Комментарий : Когда рабочий лист защищён в отношении об'ектов, то возникает ошибка 1004 и диаграмма, разумеется, не создаётся.

    Если Вас не устравает, что при создании диаграммы необходимо сразу указать её месторасположение (Left, Top) и размеры (Width, Height), то можно воспользоваться способом, который предлагает макрорекордер. А именно, создать лист диаграммы, а затем переместить диаграмму на рабочий лист, т.е.
    Application.ScreenUpdating = False
    With Charts.Add
         'Здесь Вы работаете с листом диаграммы, например,
         'указываете диапазон, который будет служить
         'источником данных
         .SetSourceData Source:=Worksheets(1).Range("A1:B20")
         
         'И когда возникнет необходимость, перемещаете
         'диаграмму на рабочий лист с указанным именем
         .Location Where:=xlLocationAsObject, Name:="Лист1"
    End With
    Application.ScreenUpdating = True
    Если же после перемещения у Вас, всё-таки, возникнет необходимость в указании месторасположения и/или размеров диаграммы, то все эти манипуляции описаны здесь [FAQ779]

    Комментарий : Когда рабочий лист защищён в отношении об'ектов, то возникает ошибка 1004 и диаграмма, разумеется, не перемещается.

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

  • В этой версии появилась возможность создавать диаграмму на рабочем листе, без указания её месторасположения и размеров, т.к. у об'кта Shapes появился новый метод AddChart, который хоть и имеет аналогичные аргументы, но они являются необязательными. Однако, у этого метода есть одна особенность, он использует выделенный диапазон в качестве источника данных для диаграммы.
  • Worksheets(1).Shapes.AddChart
    Тот же метод, но с использование четырёх из пяти именованных аргументов.
    Worksheets(1).Shapes.AddChart Left:=10, Top:=20, Width:=400, Height:=200
    
    Worksheets(1).Shapes.AddChart , 10, 20, 400, 200

  • Ответ :
  • 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() (вкупе с соответствующими изменениями)
  • Ответ : Актуально для MS Excel 2010

    Для того, чтобы после создания новой диаграммы, Вы могли узнать о этом факте, разместите в модуле ThisWorkbook(ЭтаКнига) следующее событие, где Ch это об'ект - новая диаграмма.
  • Private Sub Workbook_NewChart(ByVal Ch As Chart) 
        MsgBox Ch.Name 
    End Sub
    Комментарий : К сожалению, это событие в 2010 игнорирует появление новой диаграммы(Chart), если она создаётся путём копирования уже имеющейся диаграммы(Chart). В остальных случаях, включая, создание/перемещение/копирование диаграмм(ChartObject), расположенных на рабочем листе, проблем с отслеживанием их созданий, не наблюдается.

    Обратите внимание на то, что вышеупомянутое событие впервые появилось лишь в Microsoft Excel 2010. Но, если перед Вами поставлена задача отслеживать только создание диаграмм(Chart), то в более ранних версиях, можно использовать другое событие и небольшую проверку, т.е.
    Private Sub Workbook_NewSheet(ByVal Sh As Object) 
        If TypeOf Sh Is Chart Then 
           MsgBox Sh.Name 
        End If 
    End Sub
    Private Sub Workbook_NewSheet(ByVal Sh As Object) 
        If TypeName(Sh) = "Chart" Then 
           MsgBox Sh.Name 
        End If 
    End Sub

  • Ответ :
  • 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-2003

    Для того, чтобы по мере необходимости, например, перед печатью листа, обновить уже имеющеюся диаграмму (в данном примере) используется метод 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-2003

    Для того, чтобы после выделения области диаграммы или области построения и клика правой кнопкой мышки, в контекстном меню появилась команда, позволяющая сохранить диаграмму в виде графического файла скопируйте оба макроса и расположите их в любом стандартном модуле личной книги макросов "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 2007(и старше)
    В этой(и последующих) версиях, несмотря на добавление команды в стандартное контекстное меню, Вы его не увидите, если контекстное меню будет отображаться после клика правой кнопкой мышки.

    В качестве обходного решения, можно (на выбор) :
  • создать собственное контекстное меню , которое будет содержать необходимые команды, в т.ч. и "Экспорт диаграммы" и отображать его по мере необходимости.
  • отображать контекстное меню "Object/Plot" программно, правда в этом случае, Вы получите его старую версию, т.е. меню из версии 97-2003
  • сохранять диаграмму, после её выделения и нажатия горячих клавиш (см. далее)
  • Ответ :

    Для того, чтобы после выделения диаграммы и использовании горячих клавиш (в примере это CTRL+E) появилось стандартное диалоговое окно, позволяющее сохранить диаграмму в виде графического файла, скопируйте оба макроса и расположите их в любом стандартном модуле личной книги макросов "Personal.xls" ("Personal.xlsb")

    И разумеется, не забудьте сохранить все внесённые изменения.
  • Private Sub Auto_Open()
        Application.OnKey "^e", "ChartExport"
    End Sub
    
    Private Sub ChartExport()
        If Not ActiveChart Is Nothing Then
           iFileName = Application.GetSaveAsFilename("Chart", _
           "Формат GIF (*.gif),*gif,Формат JPG (*.jpg),*jpg", , _
           "Выберите нужную папку и введите необходимое имя файла")
           If iFileName <> False Then
              ActiveChart.Export iFileName, Right(iFileName, 3)
           Else
              MsgBox "Необходимо было указать местосохранение диаграммы", vbCritical, ""
           End If
        Else
           MsgBox "Необходимо предварительно выделить диаграмму", vbCritical, ""
        End If
    End Sub
    Примечание : Использование именно этого сочетания клавиш CTRL+E не носит обязательного характера и может быть изменено. Более того, в некоторых случаях, можно назначить клавишам макрос без использования Application.OnKey. Более подробную информацию можно получить здесь.
  • Ответ : Актуально для MS Excel 97-2003
  • 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-2003
  • 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-2018 Климов П.Ю. Все права защищены. WebDesign & Error's Klimoff