Скопируйте диаграммы на каждом листе и вставьте их в каждый слайд соответственно - PullRequest
Новая
       21

Скопируйте диаграммы на каждом листе и вставьте их в каждый слайд соответственно

0 голосов
/ 07 января 2020

Мой код теперь вставляет 1 график в 1 слайд. Как мне сделать так, чтобы все диаграммы на Листе 1 (2 диаграммы на Листе 1) вставлялись в Слайд1 и все диаграммы (2 диаграммы на Листе 2) на Листе 2 на Слайд2 и так далее ... Я попытался увеличить count, но код не работает 

Dim ppt As PowerPoint.Application
Dim ppTPres As PowerPoint.Presentation
Dim pptSld As PowerPoint.Slide
Dim pptCL As PowerPoint.CustomLayout
Dim pptShp As PowerPoint.Shape

Dim chtt As Chart
Dim ws As Worksheet
Dim i As Long

'Optimise execution of code
Application.ScreenUpdating = False

'Get the PowerPoint Application object:
Set ppt = CreateObject("PowerPoint.Application")
ppt.Visible = msoTrue
Set ppTPres = ppt.Presentations.Add

'Get a Custom Layout:
For Each pptCL In ppTPres.SlideMaster.CustomLayouts
    If pptCL.Name = "Title and Content" Then Exit For
Next pptCL

For Each ws In ActiveWorkbook.Worksheets
    For i = 1 To ws.ChartObjects.Count
        Set pptSld = ppTPres.Slides.AddSlide(ppTPres.Slides.Count + 1, pptCL)
        pptSld.Select

        For Each pptShp In pptSld.Shapes.Placeholders
            If pptShp.PlaceholderFormat.Type = ppPlaceholderObject Then Exit For
        Next pptShp

        Set chtt = ws.ChartObjects(i).Chart
        chtt.ChartArea.Copy
        ppt.Activate
        pptShp.Select
        ppt.Windows(1).View.Paste
    Next i
Next ws

'Optimise execution of code
Set chtt = Nothing
Set pptSld = Nothing
Application.ScreenUpdating = True

'Clear clipboard
Application.CutCopyMode = False
...