Notifications
Clear all

Alterar código para salvar arquivo no formato .pdf

2 Posts
2 Usuários
0 Reactions
947 Visualizações
(@marianapd)
Posts: 48
Eminent Member
Topic starter
 

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

 
Postado : 09/12/2015 11:41 am
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!!

Use a pesquisa do fórum
https://cse.google.com.br/cse?cx=partne ... gsc.page=1

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 10/12/2015 12:33 pm