DE uma vista de olhos em

viewtopic.php?f=16&t=5464&p=28526&hilit=pdf#p28526

viewtopic.php?f=16&t=5574&p=29063&hilit=pdf#p29063

Faz o que quer com pouca modificação

Achei muito interessante à segunda opção sugerida pelo Reinaldo, fiz pequenas mudança. Quero utilizar esta opção, porém, o código não me dá opção de determinar um local para salvar o arquivo. Alguém poderia adaptá-lo por favor.

Sub Gera_PDF()

Dim SvInput As String
Dim Data As String
Dim var_MENSAGEM
Dim Nome As String

Nome = "Meu teste" ' Aqui coloque o que que quiser dar ao seu arquivo
Data = VBA.Format(VBA.Date, "dd-mm-yyyy") ' Aqui é informada a data de salvamento
SvInput = ThisWorkbook.Path & Application.PathSeparator & Nome & " - Até " & Data & ".pdf"

MsgBox "Seu arquivo foi salvo com sucesso." & Chr(13) & _
"" & Chr(13) & _
"Local de salvamento: ", vbInformation, "Confirmação"

Sheets(Array("teste")).Select ' Aqui é definido o nome das planilhas que deseja salvar
For Each sh In ActiveWindow.SelectedSheets
With sh
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=SvInput, _
OpenAfterPublish:=False 'Use ''False'' para não abrir o arquivo após salvá-lo. Para abrir, use ''True''
End With
Exit For
Next
End Sub

altere a linha
SvInput = ThisWorkbook.Path & Application.PathSeparator & Nome & " - Até " & Data & ".pdf"
para:
SvInput = "xxxxxxxx" & Nome & " - Até " & Data & ".pdf"

Troque xxxxxxxx pelo local onde você deseja salvar, mantendo ""

celsoyano, boa noite.

Interessante sua resposta, porém, tem um pequeno detalhe: Se a pasta não estiver criada, o código retorna um erro, dessa forma eu teria que criar a pasta primeiro, quando na verdade, ela deveria ser criada automaticamente. Será que consegue resolver isso? De qualquer forma, obrigado pela atenção.

ahhh... um outro detalhe, quando ela salva, o arquivo existente é substituido, quero manter os 2 arquivos, sem que sejam substituídos, é pq vou analisar a evolução da planilha e, se substituir, não tem como eu fazer essa análise.

Farofa 9781, boa noite.
Tenta o código abaixo ... ele vai ferificar se existe o diretorio, se não existir ele vair criar, e também não vai mais ficar gravando por cima, toda vez que voce executar a macro ele vai gerar um arquivo diferente. Adapte os nomes das planilhas a serem salvas e o diretorio que deseja salvar. Espero ter ajudado.

Sub Gera_PDF()

Dim SvInput As String
Dim Data As String
Dim var_MENSAGEM
Dim nome As String

nome = "Meu teste" ' Aqui coloque o que que quiser dar ao seu arquivo
Data = VBA.Format(VBA.Date, "dd-mm-yyyy") ' Aqui é informada a data de salvamento
Hora = VBA.Format(VBA.Time, "hh.mm.ssss")

MyPath = "D:Teste"
    If (Dir(MyPath, vbDirectory) = "") Then
    MsgBox "Diretório - " & MyPath & " - Não encontrado"
    MkDir (MyPath)
    MsgBox "O diretório   " & MyPath & "   foi criado com sucesso.", vbInformation
    End If
 
SvInput = MyPath & Application.PathSeparator & nome & " - Até " & Data & " - " & Hora & ".pdf"

MsgBox "Seu arquivo PDF foi gerado com sucesso." & Chr(13) & "" & Chr(13) & _
"Local de salvamento:     " & MyPath, vbInformation

Sheets(Array("PLAN1")).Select ' Aqui é definido o nome das planilhas que deseja salvar
For Each sh In ActiveWindow.SelectedSheets
With sh
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=SvInput, _
OpenAfterPublish:=False
End With
Exit For
Next
End Sub

celsoyano?

alterei o código da maneira que me convia. Só não consegui alterar um detalhezinho. A linha abaixo precisa ser alterada.

If MsgBox("O diretório " & "''" & MyPath & "''" & " não foi encontrado. Deseja criá-lo agora?", vbQuestion + vbYesNo, "Criação do diretório") = vbYes Then

quando sou indagado se desejo criar o diretório, quando eu clico em "NÃO" ele é criado do mesmo jeito. Acho que é um pequeno detalhe. Depois, quero ver como quebro a linha, pois, quero passar a parte " Deseja criá-lo agora?" para a linha de baixo

a paradinha de passar parte do texto para baixo eu consegui, é pq estava inserindo o chr(13) no lugar errado. Agora falta corrigir o problema de clicar no não e salvar do mesmo jeito.

Posta o codigo por completo pra mim ver onde vc alterou!!

Sub Gerar_PDF()
Dim SvInput As String
Dim Data As String
Dim var_MENSAGEM
Dim nome As String

nome = "Cadastros" ' Aqui coloque o que que quiser dar ao seu arquivo
Data = VBA.Format(VBA.Date, "dd-mm-yyyy") ' Aqui é informada a data de salvamento
hora = VBA.Format(VBA.Time, "hh.mm.ss") ' Aqui é informada a hora de salvamento

MyPath = "D:Cadastros"
    If (Dir(MyPath, vbDirectory) = "") Then
    If MsgBox("O diretório " & "''" & MyPath & "''" & " não foi encontrado." & Chr(13) & "Deseja criá-lo agora?", vbQuestion + vbYesNo, "Criação do diretório") = vbYes Then
    End If
    MkDir (MyPath)
    MsgBox "O diretório " & "''" & MyPath & "''" & " foi criado com sucesso.", vbInformation, "Criação do diretório"
    End If
 
SvInput = MyPath & Application.PathSeparator & nome & " - Cadastrados até " & Data & " às " & hora & ".pdf"

MsgBox "Seus arquivos cadastrados até " & Data & " às " & hora & Chr(13) & "foram salvos com sucesso." & Chr(13) & _
" " & Chr(13) & _
"Local de salvamento: " & MyPath, vbInformation, "Confirmação"

Sheets(Array("Cadastros")).Select ' Aqui é definido o nome das planilhas que deseja salvar
For Each sh In ActiveWindow.SelectedSheets
With sh
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=SvInput, _
OpenAfterPublish:=False
End With
Exit For
Next
End Sub

Farofa9781?

Faça uma pequena alteração no código:

Troque:

If MsgBox("O diretório " & "''" & MyPath & "''" & " não foi encontrado." & Chr(13) & "Deseja criá-lo agora?", vbQuestion + vbYesNo, "Criação do diretório") = vbYes Then
    End If

Por:

Charlie81 = MsgBox("O diretório " & "''" & MyPath & "''" & " não foi encontrado." & Chr(13) & "Deseja criá-lo agora?", vbQuestion + vbYesNo, "Criação do diretório")
    If Charlie81 = 6 Then
    ElseIf Charlie81 = 7 Then
    Exit Sub
    End If

Ou tambem

If MsgBox("O diretório " & "''" & MyPath & "''" & " não foi encontrado." & Chr(13) & "Deseja criá-lo agora?", vbQuestion + vbYesNo, "Criação do diretório") = vbYes Then
Else
exit sub   
End If