Macro desde Excel para imprimir documentos .doc a PDF

Con esta macro podemos imprimir documentos .doc a pdf. El código original está sacado de www.excelguru.ca (web muy recomendable). Fue modificado para poder realizar el cometido que tenía entre manos. Espero que os pueda servir!


Sub CrearPDFdesdeWord(ByRef pathOrigen As Variant)

Dim pdfjob As PDFCreator.clsPDFCreator 'Impresora PDFCreator
Dim sPrinter As String 'Variable para seleccionar la impresora
Dim pathGuardar As String
Dim nombrePDF As String
Dim caracter As String

caracter = "\"
'InStrRev devuelve la posición de la primera aparición de una cadena dentro de otra, comenzando por el extremo derecho de la cadena
nombrePDF = Right(pathOrigen, Len(pathOrigen) - InStrRev(pathOrigen, caracter))
MsgBox nombrePDF
nombrePDF = Left(nombrePDF, Len(nombrePDF) - 4) & ".pdf"
pathGuardar = Range("b100").Value

On Error GoTo EarlyExit
'//SI EXISTE OTRO PROCESO DE PDF EN COLA LO ELIMINAMOS
Do
bRestart = False
Set pdfjob = New PDFCreator.clsPDFCreator
If pdfjob.cStart("/NoProcessingAtStartup") = False Then
'Si hay un proceso PDFCreator abierto lo termina
Shell "taskkill /f /im PDFCreator.exe", vbHide
DoEvents
Set pdfjob = Nothing
bRestart = True
End If
Loop Until bRestart = False

'//ASIGNAMOS PROPIEDADES AL PDFCREATOR
With pdfjob
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = pathGuardar
.cOption("AutosaveFilename") = nombrePDF
.cOption("AutosaveFormat") = 0
.cClearCache
End With

'//ABRIMOS LA APLICACION DE WORD
Set ObjWord = CreateObject("word.application")
ObjWord.Documents.Open (pathOrigen)
ObjWord.Visible = False
With ObjWord
sPrinter = CStr(.ActivePrinter)
.ActivePrinter = "PDFCreator"
.Options.PrintBackground = False
.ScreenUpdating = False
End With

'//IMPRESION DEL DOCUMENTO WORD
ObjWord.Application.PrintOut copies:=1

Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop

pdfjob.cPrinterStop = False

'Wait until PDF creator is finished then release the objects

Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop

Application.Wait Now + TimeValue("0:0:5")

Cleanup:
'//BORRA LOS OBJETOS Y CIERRA LA APLICACION PDFCreator
'pdfjob.cClose
'Set pdfjob = Nothing
Shell "taskkill /f /im PDFCreator.exe", vbHide
On Error GoTo 0
With ObjWord
.ScreenUpdating = True
.ActivePrinter = sPrinter
.Options.PrintBackground = bBkgrndPrnt
.Documents.Close
.Quit
End With
Set ObjWord = Nothing
Exit Sub
EarlyExit:
'//SI HAY UN ERROR AL PPCIO SALE Y DA EL AVISO
MsgBox "Se ha encontrado un error. PDFCreator tiene" & vbCrLf & _
"tiene que terminar.", _
vbCritical + vbOKOnly, "Error"
Resume Cleanup

End Sub

Hacia dónde me muevo

Hola a tod@s,

intentaré a partir de ahora ser más asiduo a este blog. Aportar alguna cosa entre las que me estoy moviendo. Últimamente ando con temas de programación con macros... espero que puedan ayudar igual que a mi me ayudaron en su momento desde otros lados.

Pues sin más empezamos....