none
Problema 429 no codigo VBA para localizar e substituir valores em um PPT através do Excel RRS feed

  • Pergunta

  • Estou tentando fazer um programa que pegue os valores de uma planilha excel e substituam os valores em uma apresentação de PowerPoint.

    O código até agora é esse:

    Sub mudar_nome_powerpoint()
    
      Dim PowerPoint As Object
      Dim ppPres As Object
       
      Set appPowerPoint = CreateObject("PowerPoint.Application")
      appPowerPoint.Visible = True
      
      Set ppPres = appPowerPoint.Presentations.Open(ActiveWorkbook.Path & "\Sistema.pptm")
    
        FindReplace "#Cliente", "Daniel"
    
    End Sub
    
    Sub FindReplace(pFindWord As String, pReplaceWord As String)
        'PURPOSE: Find & Replace text/values throughout entire PowerPoint presentation
        'SOURCE: www.TheSpreadsheetGuru.com/the-code-vault
       
        Dim sld As Slide
        Dim shp As Shape
        Dim ShpTxt As TextRange
        Dim TmpTxt As TextRange
        
        'Loop through each slide in Presentation
        For Each sld In Presentations("Sistema.pptm").Slides
        
            For Each shp In sld.Shapes
                If shp.HasTextFrame = False Then GoTo ContinueShape
                
                'Store text into a variable
                Set ShpTxt = shp.TextFrame.TextRange
                
                'Find First Instance of "Find" word (if exists)
                Set TmpTxt = ShpTxt.Replace(FindWhat:=pFindWord, _
                                            Replacewhat:=pReplaceWord, _
                                            WholeWords:=False)
                
                'Find Any Additional instances of "Find" word (if exists)
                Do While Not TmpTxt Is Nothing
                    Set ShpTxt = ShpTxt.Characters(TmpTxt.Start + TmpTxt.Length, ShpTxt.Length)
                    
                    Set TmpTxt = ShpTxt.Replace(FindWhat:=pFindWord, _
                                                Replacewhat:=pReplaceWord, _
                                                WholeWords:=True)
                Loop
    ContinueShape:
            Next shp
        Next sld
    End Sub

    Ocorre o problema "Run Time error "429" AcitveX  component can-t create  object" quando chega na linha abaixo.

      For Each sld In Presentations("Sistema.pptm").Slides

    Alguém sabe como me ajudar?

    Agradeço desde já

    terça-feira, 15 de janeiro de 2019 13:10