Guardar Documentos de Word a PDF con Macro

Nuevamente pidiendo tu apoyo:

LA Macro que me hiciste favor de crearla para generar documentos de acuerdo a una variable funciona a la perfecccion, pero tengo una pregunta:

¿Existe algún modo el cual al momento de ir generando los documentos individuales, estos documentos se guarden en ves de documento en Word se puedan guardar en PDF?

1 respuesta

Respuesta
6

Te anexo la macro para guardar Word y 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 & "\"
        nombd = ruta & Cells(i, "A") & ".docx"
        nombp = ruta & Cells(i, "A") & ".pdf"
        objWord.ActiveDocument.SaveAs nombd
        pdf = objWord.ActiveDocument.ExportAsFixedFormat(nombp, _
            wdExportFormatPDF, False, 0, 0, , , 0, False, True, 1)
        objWord.Quit (False)
    Next
End Sub

Si solamente quieres el Pdf, quita esta línea

ObjWord. ActiveDocument. SaveAs nombd

Prueba y me comentas.

Saludos. Dante Amor

Utiliza esta macro

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 & "\"
        nombd = ruta & Cells(i, "A") & ".docx"
        nombp = ruta & Cells(i, "A") & ".pdf"
        objWord.ActiveDocument.SaveAs nombd
        pdf = objWord.ActiveDocument.ExportAsFixedFormat( _
            nombp, 17, False, 0, 0, , , 0, False, True, 1)
        objWord.Quit (False)
    Next
End Sub

¡Gracias! Dante, nuevamente mil gracias por tu ayuda apenas acabo de checar la macro y funciona perfectamente, solo quisiera ver si podrías explicarme la siguiente línea de código,

( _nombp, 17, False, 0, 0,,, 0, False, True, 1)

nuevamente gracias!

Corresponden a estos parámetros:

Expression. ExportAsFixedFormat(FixedFormat, OutputFileName, Intent, PrintRange, FromPage, ToPage, ColorAsBlack, IncludeBackground,IncludeDocumentProperties, IncludeStructureTags, UseISO19005_1, FixedFormatExtClass)

El detalle puedes verlo en este enlace:

https://msdn.microsoft.com/en-us/library/ms409271%28v=office.12%29.aspx 

Buenas noches Dante, espero estés bien nuevamente ¡Gracias! Por tu valioso tiempo y tu grandísima ayuda, ¿Algún Tip para poder empezar a desarrollar Macros?.

Saludos.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas