Изменение размера диаграммы в VBA при экспорте в power point

#vba #export #powerpoint

Вопрос:

Я пытаюсь увеличить экспортированные диаграммы на слайде PowerPoint, но продолжаю сталкиваться с проблемами с циклом. Есть какие-нибудь идеи?

 Sub Export_Worksheet()

    Dim PPTApp As PowerPoint.Application
    Dim PPTPres As PowerPoint.Presentation
    Dim PPTSlide As PowerPoint.Slide
    Dim PPTShape As PowerPoint.Shape
    Dim SldIndex As Integer

    Dim Chrt As ChartObject
    
    Set PPTApp = New PowerPoint.Application
        PPTApp.Visible = True

    Set PPTPres = PPTApp.Presentations.Add

    SldIndex = 1

    For Each Chrt In ActiveSheet.ChartObjects

        Chrt.Copy
    
        Set PPTSlide = PPTPres.Slides.Add(SldIndex, ppLayoutBlank)
            PPTSlide.Shapes.Paste

        SldIndex = SldIndex   1
        
    Next Chrt

End Sub
 

Ответ №1:

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

 Sub Export_Worksheet()
    Dim PPTApp As PowerPoint.Application
    Dim PPTPres As PowerPoint.Presentation
    Dim PPTSlide As PowerPoint.Slide
    Dim PPTShape As PowerPoint.Shape
    Dim SldIndex As Integer

    Dim Chrt As ChartObject
    
    Set PPTApp = New PowerPoint.Application
        PPTApp.Visible = True

    Set PPTPres = PPTApp.Presentations.Add

    SldIndex = 1

    For Each Chrt In ActiveSheet.ChartObjects

        Chrt.Copy
    
        Set PPTSlide = PPTPres.Slides.Add(SldIndex, ppLayoutBlank)
            PPTSlide.Shapes.Paste
        With PPTPres.Slides(SldIndex).Shapes("Chart 1")
            .Top = 170
            .Left = 530
            .Height = 250
            .Width = 400
        End With
        SldIndex = SldIndex   1
        
    Next Chrt

End Sub

 

Комментарии:

1. Это прерывает цикл и приводит к «Ошибке автоматизации во время выполнения 2147188160 (80048240)».

2. вы можете точно рассчитать название диаграммы PPTSlide.Shapes.Paste For Each j In PPTPres.Slides(SldIndex).Shapes localName = j.Name Next