Редактирование диаграммы PowerPoint с помощью VBA

[Igor]

Здравствуйте!

Нужна помощь в решении следующей задачи в PowerPoint. Есть самая простая диаграмма (выглядит как на изображении №1 в приложении).
А получить нужно такую же диаграмму, но уже с добавленными окружностями вокруг подписей данных (выглядит как на изображении №3 в приложении). Окружности должны автоматически добавляться к подписям данных на основании таблицы данных Excel (как на изображении №2 в приложении). Т.е. если в Excel ячейка с числом окрашена в зеленый цвет, то и на диаграмме это число должно быть обведено в зеленый круг. Аналогично происходит и с ячейкой окрашенной в красный цвет.

Заранее спасибо за помощь!

[Дмитрий Щербаков(The_Prist)]

Добрый день.
Скажу по секрету - никто не горит желанием делать из Ваших рисунков файлы, данные к ним и потом пытаться Вам помочь. приложите исходные файлы Excel и PP.

[Igor]

Не уверен, что мое предыдущее сообщение было опубликовано. Пишу еще раз.

В архиве в приложении находится слайд презентации PowerPoint. Это искомый вид диаграммы. Окружности вокруг подписей данных я сделал вручную. Красная окружность, если ячейка во значением имеет красный цвет, зеленая окружность - если зеленый.

[Igor]

Ну, неужели ни у кого нет никаких соображений? Подскажите хотя бы, как обратиться к скрытой таблице Excel, которая связана с этой диаграммой и содержит ее данные...

[Дмитрий Щербаков(The_Prist)]

Код (vb) Выделить Развернуть

Sub GetTable()
   Dim oCh As Chart
   Set oCh = ActivePresentation.Slides(1).Shapes(1).Chart
   
   With oCh.SeriesCollection(1).Points(1).DataLabel.Format.Line
       .ForeColor.RGB = RGB(255, 0, 0)
   End With
End Sub
Это, пожалуй, пока единственно, что могу подсказать. Т.к. у Вас вставка диаграммы изет через связь - сложно получить исходные данные.
И подписи в виде окружностей не сделать - нет такого. У меня по крайней мере.

[Igor]

Спасибо за ответ! Буду пробовать.
Сами окружности в таком виде, как мне хотелось бы, нарисовать не проблема с помощью такого кода:

Код (vb) Выделить Развернуть


Sub DrawCircles()

    ActiveSheet.ChartObjects("Inhaltsplatzhalter 4").Activate
    ActiveChart.FullSeriesCollection(1).DataLabels.Select
    ActiveChart.FullSeriesCollection(1).Points(1).DataLabel.Select
    Selection.Format.AutoShapeType = msoShapeOval
    Selection.Height = 31.1811023622047
    Selection.Width = 31.1811023622047
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(0, 176, 80)
        .Transparency = 0
        .Visible = msoTrue
        .Weight = 1.5
    End With
    End Sub



[Дмитрий Щербаков(The_Prist)]

Это понятно. Нарисовать может и не проблема, а вот привязать их по координатам четко к линиям графика - не так просто.

[novodom]

Интересно, никогда бы не подумал, что такое возможно в принципе