Генерация нескольких файлов PowerPoint путем обновления диаграммы

Question

Мне нужно сгенерировать несколько файлов powerpoint, обновив диаграмму на 2-м слайде для данных Excel, доступных в каждой строке (Dynami c количество строк)

У меня есть файл Excel с примерно 1000 строк (count является Dynami c каждый раз), и каждая строка представляет собой запись, на основе 1 строки я создал диаграмму в самом Excel, которую мне нужно скопировать на втором слайде моего существующего шаблона ppt. Таким образом, мне нужно сгенерировать 1000 ppts и сохранить файлы на основе имени, доступного в той же строке, может ли кто-нибудь помочь мне решить этот запрос.

Мой лог c - что-то вроде этого. L oop через все строки Создать лист Создать диаграмму для первой строки Скопировать вставить на слайде ppt fist Затем удалить диаграмму или лист в рабочей книге Повторите все шаги до конца

Ниже приведен код, который я пробовал ранее где я создал диаграмму в ppt и связал ее с первой строкой моего файла данных, но это решает только половину моей проблемы: я могу создать только один отчет, а не несколько.

Sub Update()
Dim CName, pth
pth = ThisWorkbook.Path
Dim pptPres As PowerPoint.Presentation
Dim pptApp As PowerPoint.Application
Dim Sld As PowerPoint.Slide
Dim sh As PowerPoint.Shape
Dim wb As Workbook
Dim aLinks As Variant
Dim FName  As String
Dim strPptTemplatePath As String


strPptTemplatePath = "C:\Users\DSS1080\Desktop\Business continuity planning\Report Template.pptx"

Application.ScreenUpdating = False
Set pptApp = CreateObject("PowerPoint.Application")
pptApp.Visible = msoTrue
Set pptPres = pptApp.Presentations.Open(strPptTemplatePath, untitled:=msoTrue)
NewLink = pth & "\" & ThisWorkbook.Name
pptApp.Activate
For Each Sld In pptPres.Slides
    For Each sh In Sld.Shapes
    If sh.Type = msoChart Then
                 sh.Chart.ChartData.Activate
                 Set wb = sh.Chart.ChartData.Workbook
                 aLinks = wb.LinkSources(xlExcelLinks)
                    wb.Sheets(1).Cells(100, 100).Value = aLinks
                    Oldfile = Cells(100, 100).Value
                    wb.ChangeLink Name:=Oldfile, NewName:=NewLink, Type:=xlExcelLinks
                    wb.Sheets(1).Cells(100, 100).Clear
                wb.Close False
                 Set wb = Nothing
                 sh.Chart.ChartData.Activate
                 Set wb = sh.Chart.ChartData.Workbook
                 wb.Close False
                 Set wb = Nothing
    End If
Next
Next

FName = Sheets("Quadrant").Range("C1").Text
CName = Left(strPptTemplatePath, Len(strPptTemplatePath) - 19) & FName
pptPres.SaveAs CName, ppSaveAsDefault
pptPres.Close
Set pptPres = Nothing
pptApp.Quit
Set pptApp = Nothing
Application.ScreenUpdating = True

End Sub