Este fórum está sendo desativado

[Guigo2810]

Bom dia,
Criei uma macro no Excel que abre diversos arquivos que já existem em Power Point, atualiza os vínculos destes arquivos, e posteriormente - deveria - exportar como PDF.

Quase toda a macro está Ok, somente o exportar como PDF não está funcionando. Utilizei dois códigos diferentes, o que me retorna problemas diferentes, vamos lá:
- Utilizando o código ppt.ActivePresentation.SaveAs Link & "\" & Y & ".pdf" (Sim, o nome do arquivo é variável, ou seja, utiliza o Y, mas esse não é problema pois posteriormente salvo o mesmo arquivo como ".pptx" e funciona): O erro acontece quando abro o PDF, pois diz que "O adobe reader não pode abrir o arquivo porque não há suporte a esse tipo de arquivo ou ele foi danificado (por exemplo, foi enviado como anexo de e-mail e não foi decodificado corretamente)".
- Utilizando ppt.ActivePresentation.ExportAsFixedFormat ActivePresentation.Path & "\" & ActivePresentation.Name & ".pdf", ppFixedFormatTypePDF, ppFixedFormatIntentPrint (Utiliza a mesma variável de nome, conforme acima): O erro acontece na execução da Macro, no qual é o erro 429, ou seja, "O componente ActiveX não pode criar objeto.

Observação: Já carreguei o Adobe Reader 11 como referência.

E então, o que devo fazer para conseguir exportar esse ppt para pdf?

Agradeço desde já!

[alexandrevba]

Bom dia!!
Fonte:http://www.listendata.com/2013/10/conve ... -into.html
Tente

Código: Selecionar todos

Option Explicit
Dim oPPTApp As PowerPoint.Application
Dim oPPTFile As PowerPoint.Presentation
Sub Converter()
'Fonte:http://www.listendata.com/2013/10/convert-multiple-powerpoint-files-into.html
Dim cnt As Integer, currfile As String
Dim TrimFile As String, Path As String, FilesInPath As String _
, MyFiles() As String, Fnum As Long
Dim CalcMode As Long, LPosition As Long
Dim StartTime As Date, EndTime As Date
      
ThisWorkbook.Activate
currfile = ActiveWorkbook.Name
         
Windows(currfile).Activate
Sheets("Sheet1").Activate
    
StartTime = Timer
Path = Range("C3").Text & "\"

FilesInPath = Dir(Path & "*.pp*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
  Set oPPTApp = CreateObject("PowerPoint.Application")
    oPPTApp.Visible = msoTrue
      
    On Error Resume Next
    
Set oPPTFile = oPPTApp.Presentations.Open(Path & MyFiles(Fnum))
    
On Error GoTo 0

If Not oPPTFile Is Nothing Then

LPosition = InStr(1, oPPTFile.Name, ".") - 1
TrimFile = Left(oPPTFile.Name, LPosition)

On Error Resume Next
    
oPPTFile.ExportAsFixedFormat oPPTFile.Path & "\" & TrimFile & ".pdf", _
ppFixedFormatTypePDF, ppFixedFormatIntentPrint
    
   End If
   
oPPTFile.Close
   
   Next Fnum
End If


With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
 
    oPPTApp.Quit

    Set oPPTFile = Nothing
    Set oPPTApp = Nothing
    
EndTime = Timer
MsgBox " Tarefa com sucesso concluída em " & Format(EndTime - StartTime, "0.00") & " segundos"
End Sub

Att

[Guigo2810]

Consegui uma solução em outro fórum. Compartilho abaixo:

Na rotina altere a declaração de variaveis, conforme abaixo:

Dim PPT As PowerPoint.Application
Set PPT = New PowerPoint.Application

e a linha de pdf conforme abaixo
CÓDIGO: SELECIONAR TODOS
PPT.activepresentation.ExportAsFixedFormat Link & y & ".pdf", ppFixedFormatTypePDF, ppFixedFormatIntentPrin