Excel VBA Excel/PowerPoint - Apenas a primeira iteração do loop exporta o arquivo em P

[Vilsonrjr]

Olá,

Gostaria de uma ajuda para entender o por quê do meu script VBA não estar funcionando.

O meu objetivo é, através da iteração das linhas de uma tabela no Excel, alimentar 4 TextBoxes de um slide no PPT e então salvar o arquivo e imediatamente exportá-lo como PDF.

Segue o script:

 

Option Explicit

Sub GerarCertificado()

Dim tb As ListObject
Dim linha As ListRow
Dim ppt As PowerPoint.Application
Dim apresentacao As PowerPoint.Presentation
Dim slide As PowerPoint.slide
Dim sp As PowerPoint.Shape

Set ppt = New PowerPoint.Application
ppt.Visible = True

Set tb = Planilha1.ListObjects("tbDados")

For Each linha In tb.ListRows
    
    Set apresentacao = ppt.Presentations.Open(ThisWorkbook.Path & "\" & "MODELO.pptx")
    
    On Error Resume Next
    For Each slide In apresentacao.Slides
        For Each sp In slide.Shapes
            sp.TextFrame.TextRange.Text = VBA.Replace(sp.TextFrame.TextRange.Text, "#MATERIAL", linha.Range(1, 1))
            sp.TextFrame.TextRange.Text = VBA.Replace(sp.TextFrame.TextRange.Text, "#LOTE", linha.Range(1, 2))
            sp.TextFrame.TextRange.Text = VBA.Replace(sp.TextFrame.TextRange.Text, "#ORDEM", linha.Range(1, 3))
            sp.TextFrame.TextRange.Text = VBA.Replace(sp.TextFrame.TextRange.Text, "#DATA", linha.Range(1, 4))
        Next sp
    Next slide
    On Error GoTo 0
    
    apresentacao.SaveCopyAs ThisWorkbook.Path & "\TAGS\" & Cells(2, 1).Value & " - " & Cells(2, 2).Value, ppSaveAsPDF
    apresentacao.Close
    
Next linha

ppt.Quit
Set ppt = Nothing

End Sub

Como podem ver estou salvando o arquivo a cada iteração das linhas mas por algum motivo ao final da execução apenas o arquivo da primeira linha foi exportado e eu não consigo entender o motivo.

Eu esperava que a cada iteração um novo arquivo fosse exportado mas isso não acontece. Já tentei iniciar a apresentação fora do loop e colocar o comando para salvar dentro do loop dos slides mas acho que isso não seria nada que resolvesse o problema.

[Midori]

Em 07/01/2023 às 19:06, Vilsonrjr disse:

    apresentacao.SaveCopyAs ThisWorkbook.Path & "\TAGS\" & Cells(2, 1).Value & " - " & Cells(2, 2).Value, ppSaveAsPDF

 

Aí está salvado sempre o arquivo com o mesmo nome, veja que a macro só busca os valores de Cells(2, 1) e Cells(2, 2).