Boa tarde!
Eu tenho o código em VBA anexo e ele roda corretamente, ocorre que ele gera meus arquivos em word, e eu queria que a partir de agora salvasse em .pdf, é possível alterá-lo? Segue abaixo:
Option Explicit
Sub Gerar_memos()
Call FnBookMarkInsertAfter
End Sub
Function FnBookMarkInsertAfter()
Application.ScreenUpdating = False
Dim objWord
Dim objDoc
Dim objRange
Dim caminho_arq_atual As String
Dim caminho_verificado As String
Dim letter_name As String
Dim caminho_completo As String
Dim caminho_word_novo As String
Dim aba_nomes As String
Dim nome_arquivo_modelo As String
Dim lin As Integer
Dim Model_Folder As String
Dim Output_folder As String
Dim Caminho_original As String
Dim Nome As String
Dim Base_1
Dim PLR_1
Dim Extraordinary_1
Dim Salary13_1
Dim Vacation_1
Dim Other_1
Dim PSFR_1
Dim Total_1
Dim Base_2
Dim PLR_2
Dim Extraordinary_2
Dim Salary13_2
Dim Vacation_2
Dim Other_2
Dim PSFR_2
Dim Total_2
Dim Bucket_1
Dim Bucket_2
Dim Increase_2
'lê dados da aba parâmetro
aba_nomes = Sheets("Parameters").Range("b2")
nome_arquivo_modelo = Sheets("Parameters").Range("e2")
letter_name = Sheets("Parameters").Range("e3")
Model_Folder = Sheets("Parameters").Range("e4")
Output_folder = Sheets("Parameters").Range("e5")
Set objWord = CreateObject("Word.Application")
Caminho_original = ThisWorkbook.Path
caminho_verificado = ThisWorkbook.Path & "" & Model_Folder
'caminho_completo = caminho_verificado & "" & nome_arquivo_modelo
caminho_completo = ThisWorkbook.Path & "" & Model_Folder & "" & nome_arquivo_modelo
'começa a ler os nomes a partir da linha 2
lin = 2
'lê os valores das variáveis para gerar o nome do arquivo
Nome = Sheets(aba_nomes).Range("a" & lin)
Do While Nome <> ""
'atualiza valor das variáveis para a próxima linha
Nome = Sheets(aba_nomes).Range("a" & lin)
'se célular de bonus base estiver vazia, deixar todas as variáveis como vazio
If Sheets(aba_nomes).Range("b" & lin) = "" Then
Base_1 = ""
PLR_1 = ""
Extraordinary_1 = ""
Salary13_1 = ""
Vacation_1 = ""
Other_1 = ""
PSFR_1 = ""
Total_1 = ""
Bucket_1 = ""
Else
Base_1 = Format(Sheets(aba_nomes).Range("b" & lin), "Currency")
Bucket_1 = Format(Sheets(aba_nomes).Range("c" & lin), "Currency")
PLR_1 = Format(Sheets(aba_nomes).Range("d" & lin), "Currency")
Extraordinary_1 = Format(Sheets(aba_nomes).Range("e" & lin), "Currency")
Salary13_1 = Format(Sheets(aba_nomes).Range("f" & lin), "Currency")
Vacation_1 = Format(Sheets(aba_nomes).Range("g" & lin), "Currency")
Other_1 = Format(Sheets(aba_nomes).Range("h" & lin), "Currency")
PSFR_1 = Format(Sheets(aba_nomes).Range("i" & lin), "Currency")
Total_1 = Format(Sheets(aba_nomes).Range("j" & lin), "Currency")
End If
Base_2 = Format(Sheets(aba_nomes).Range("k" & lin), "Currency")
Bucket_2 = Format(Sheets(aba_nomes).Range("l" & lin), "Currency")
PLR_2 = Format(Sheets(aba_nomes).Range("m" & lin), "Currency")
Extraordinary_2 = Format(Sheets(aba_nomes).Range("n" & lin), "Currency")
Salary13_2 = Format(Sheets(aba_nomes).Range("o" & lin), "Currency")
Vacation_2 = Format(Sheets(aba_nomes).Range("p" & lin), "Currency")
Other_2 = Format(Sheets(aba_nomes).Range("q" & lin), "Currency")
PSFR_2 = Format(Sheets(aba_nomes).Range("r" & lin), "Currency")
Total_2 = Format(Sheets(aba_nomes).Range("s" & lin), "Currency")
Increase_2 = Format(Sheets(aba_nomes).Range("t" & lin), "0.00%")
Set objDoc = objWord.Documents.Open(caminho_completo)
objWord.Visible = True
Set objRange = objDoc.Bookmarks("Name").Range
objRange.InsertAfter (Nome)
Set objRange = objDoc.Bookmarks("Name_2").Range
objRange.InsertAfter (Nome)
Set objRange = objDoc.Bookmarks("Base_1").Range
objRange.InsertAfter (Base_1)
Set objRange = objDoc.Bookmarks("Bucket_1").Range
objRange.InsertAfter (Bucket_1)
Set objRange = objDoc.Bookmarks("PLR_1").Range
objRange.InsertAfter (PLR_1)
Set objRange = objDoc.Bookmarks("Extraordinary_1").Range
objRange.InsertAfter (Extraordinary_1)
Set objRange = objDoc.Bookmarks("Salary13_1").Range
objRange.InsertAfter (Salary13_1)
Set objRange = objDoc.Bookmarks("Vacation_1").Range
objRange.InsertAfter (Vacation_1)
Set objRange = objDoc.Bookmarks("Other_1").Range
objRange.InsertAfter (Other_1)
Set objRange = objDoc.Bookmarks("PSFR_1").Range
objRange.InsertAfter (PSFR_1)
Set objRange = objDoc.Bookmarks("Total_1").Range
objRange.InsertAfter (Total_1)
Set objRange = objDoc.Bookmarks("Base_2").Range
objRange.InsertAfter (Base_2)
Set objRange = objDoc.Bookmarks("Bucket_2").Range
objRange.InsertAfter (Bucket_2)
Set objRange = objDoc.Bookmarks("PLR_2").Range
objRange.InsertAfter (PLR_2)
Set objRange = objDoc.Bookmarks("Extraordinary_2").Range
objRange.InsertAfter (Extraordinary_2)
Set objRange = objDoc.Bookmarks("Salary13_2").Range
objRange.InsertAfter (Salary13_2)
Set objRange = objDoc.Bookmarks("Vacation_2").Range
objRange.InsertAfter (Vacation_2)
Set objRange = objDoc.Bookmarks("Other_2").Range
objRange.InsertAfter (Other_2)
Set objRange = objDoc.Bookmarks("PSFR_2").Range
objRange.InsertAfter (PSFR_2)
Set objRange = objDoc.Bookmarks("Total_2").Range
objRange.InsertAfter (Total_2)
Set objRange = objDoc.Bookmarks("Increase_2").Range
objRange.InsertAfter (Increase_2)
'define nome do arquivo novo
caminho_word_novo = (Caminho_original & "" & Output_folder & "" & "Compensation Memo-2015" & " - " & Nome & ".docx")
'salva o arquivo word
objDoc.SaveAs (caminho_word_novo)
'fecha arquivo word
objDoc.Close
'próxima linha de dados
lin = lin + 1
Nome = Sheets(aba_nomes).Range("a" & lin)
Loop
objWord.Quit
Set objWord = Nothing
'Set objDoc.SaveAs = Nothing
Set objRange = Nothing
Application.ScreenUpdating = True
MsgBox "Compensation memos were saved on the folder " & Output_folder & ".", , "XXX"
End Function
Muito obrigada!
Mariana