Macro para guardar una área de impresión en PDF
Necesito generar una macro donde me permita guardar una área de impresión en PDF, con las siguientes características:
- Que me la guarde con el nombre de una celda de esa hoja.
- Que pueda ejecutarse en cualquier PC.
- Se guarde en una carpeta en el escritorio de cualquier PC.
Respuesta de Programar Excel
Como estás esto te puede ayudar
Si bien la macro envía mail lo primero que hace es guardar en PDF fijate esa parte del código
1 respuesta más de otro experto
Respuesta de Dante Amor
2
Te anexo la macro
Sub Macro8()
'
' Por Dante Amor
'
Dim objWSHShell As Object
warea = ActiveSheet.PageSetup.PrintArea
ruta = ""
On Error Resume Next
Set objWSHShell = CreateObject("WScript.Shell")
ruta = objWSHShell.SpecialFolders("Desktop")
arch = ActiveSheet.Range("A2").Value
Set objWSHShell = Nothing
On Error GoTo 0
'
If ruta <> "" Then
If arch <> "" Then
Range(warea).ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ruta & "\" & arch & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
MsgBox "Archivo creado"
Else
MsgBox "Falta el nombre del archivo"
End If
Else
MsgBox "No se puede obtener la carpeta del escritorio"
End If
End Sub'.[Sal u dos. Dante Amor. No olvides valorar la respuesta. '.[Avísame cualquier duda
Muchas gracias funciona a la perfección, gracias Dante, una pregunta, en caso de que quiera que ese archivo se guarde en una carpeta que ya este creada en el escritorio como tendría que ir la ruta?
Quedaría así:
Sub Macro8()
'
' Por Dante Amor
'
Dim objWSHShell As Object
warea = ActiveSheet.PageSetup.PrintArea
ruta = ""
carpeta = "datos"
On Error Resume Next
Set objWSHShell = CreateObject("WScript.Shell")
ruta = objWSHShell.SpecialFolders("Desktop")
arch = ActiveSheet.Range("A2").Value
Set objWSHShell = Nothing
On Error GoTo 0
'
If ruta <> "" Then
If arch <> "" Then
Range(warea).ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ruta & "\" & carpeta & "\" & arch & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
MsgBox "Archivo creado"
Else
MsgBox "Falta el nombre del archivo"
End If
Else
MsgBox "No se puede obtener la carpeta del escritorio"
End If
End SubCambia en esta línea:
carpeta = "datos"
"datos" por el nombre de la carpeta.
'.[Sal u dos. Dante Amor. No olvides valorar la respuesta.