Este fórum está sendo desativado

[SandroLima]

Bom dia, colegas do fórum

Tenho esse arquivo que estampa uma marca d'água (Plano de Fundo) no PDF gerado a partir de uma planilha do Excel.

No módulo 01 (original) a macro executa a rotina desejada perfeitamente estampa a marca d'água, gera e salva o PDF com e sem estampa na pasta onde se encontra o arquivo do excel e abre o PDF ao final.

No módulo 02 (modificado), fiz uma pequena alteração na estrutura de gravação (nome do arquivo gerado) da maneira que preciso que ele seja salvo e a partir de então ele executa toda a rotina EXCETO por apresentar um erro e não abrir o PDF com a estampa ao final da rotina.

Algum colega poderia verificar e me ajudar com isso.

Segue anexo com os aplicativos para a realização da tarefa.

Muito obrigado a todos que puderem colaborar.

[mprudencio]

É so trocar

OpenAfterPublish:=False

Por

OpenAfterPublish:=True

[SandroLima]

Não é esse o erro.

Peço que teste o módulo estampa modificado (botão módulo 2) e verá.

Ele deveria fazer como o módulo 01 e abrir o pdf com a estampa da marca d'água... mas não faz isso e apresenta o referido erro.

[Reinaldo]

Aparentemente o comando para abrir o arquivo não aceita espaços na nomenclatura do arquivo
Experimente:

Código: Selecionar todos

Public Sub SALVAR_PDF()
    Dim pdfIn As String, sPath As String, Nome As String
    Dim pdfStamp As String
    Dim pdfOut As String
    Dim Pdtk As String
    Dim strExec As String
    
    VBA.ChDir ThisWorkbook.Path & "\"
    
    On Error GoTo trataErro
    
    Application.ScreenUpdating = False
    sPath = ThisWorkbook.Path & "\"
    With wshRecibo
    Nome = VBA.Replace(.Range("F14"), " ", "_")
        Pdtk = "PdfTk.exe"
        pdfIn = "RECIBO.pdf"
        pdfStamp = "SeuLogoMarcadAgua.pdf"
       
        'Essa é a estrutura atual com a qual preciso salvar o nome do PDF gerado. Gera o PDF mas apresenta um erro e não abreo PDF gerado no final
        pdfOut = Format(Date, "yyyy.mm.dd") & "_" & Nome & "(RECIBO)" & ".pdf"
       
        .PageSetup.PrintArea = ""
        .PageSetup.PrintArea = .Range("B9:P43").Address(External:=True)
        
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ThisWorkbook.Path & "\RECIBO.pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
        
        .PageSetup.PrintArea = ""
        
               
    End With
    
    strExec = Chr(34) & Chr(34) & sPath & Pdtk & Chr(34) & " """ & sPath & pdfIn & """ background " & Chr(34) & _
    sPath & pdfStamp & Chr(34) & " output """ & sPath & pdfOut & """" ' Estrut. do comando
    
           Call VBA.Shell("cmd.exe /C " & strExec, vbMinimizedNoFocus) ' cmd chama o utilit.que converte
    
    Application.Wait (Now + TimeValue("00:00:06")) ' aguarda 6 seg.
    
     If Not Dir(sPath & pdfOut) = "" Then ' verf. se o arquivo existe
            Call VBA.Shell("cmd.exe /C Start " & Dir(sPath & pdfOut), vbMinimizedNoFocus) 'cmd abre o pdf convertido
     End If

trataErro:

Application.ScreenUpdating = True

End Sub