Como hacer que esta macro guarde en pdf?
Sub CorrespondenciaConWord()
'Por.Dante Amor
'
patharch = ThisWorkbook.Path & "\plantilla1.dotx"
'
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.documents.Add Template:=patharch, NewTemplate:=False, DocumentType:=0
'
For j = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
textobuscar = Cells(1, j)
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=textobuscar
'
While objWord.Selection.Find.found = True
objWord.Selection.Text = Cells(i, j) 'texto a reemplazar
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=textobuscar
Wend
'
Next
'
ObjWord. Activate
ObjWord. ActiveDocument.SaveAs Cells(i, "A").Value
objWord. ActiveDocument. Close
objWord. Quit
Next
End Sub
1 respuesta
Respuesta de Dante Amor
2
Te anexo la macro actualizada para guardar también como pdf
Sub CorrespondenciaConWord()
'Por.Dante Amor
'
patharch = ThisWorkbook.Path & "\plantilla1.dotx"
'
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.documents.Add Template:=patharch, NewTemplate:=False, DocumentType:=0
'
For j = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
textobuscar = Cells(1, j)
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=textobuscar
'
While objWord.Selection.Find.found = True
objWord.Selection.Text = Cells(i, j) 'texto a reemplazar
objWord.Selection.Move 6, -1
objWord.Selection.Find.Execute FindText:=textobuscar
Wend
'
Next
'
ruta = ThisWorkbook.Path & "\"
nombp = ruta & Cells(i, "A").Value & ".pdf"
'
ObjWord. Activate
objWord.ActiveDocument.SaveAs Cells(i, "A").Value
pdf = objWord.ActiveDocument.ExportAsFixedFormat( _
Nombp, 17, False, 0, 0,,, 0, False, True, 1)
ObjWord. ActiveDocument. Close
ObjWord. Quit (False)
Next
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
