Macro para convertir a pdf e imprimir hoja activa
Necesito una macro que me convierta la hoja activa a pdf, me la guarde en el escritorio en una carpeta llamada INVENTARIO y luego me la imprima. La hoja activa puede ser cualquiera de entre 5 hojas, el nombre con que se guardara esta en la celda L2 (nombre) y M2 (fecha). La idea es que si estoy en la hoja 3 y yo presione el boton IMPRIMIR en el userform se convierta a pdf, lo guarde en la carpeta y de una vez lo imprima. Y asi si estoy en la hoja 1 o 2 o 4 o 5.
1 Respuesta
H o l a:
Pon el siguiente código en el formulario, cambia CommmadButton1 por el nombre de tu botón.
Private Sub CommandButton1_Click()
'Por.Dante Amor
ruta = escritorio()
If ruta = "" Then
MsgBox "No existe la carpeta escritorio"
Exit Sub
End If
carpeta = "INVENTARIO"
If Dir(ruta & "\" & carpeta, vbDirectory) = "" Then
MsgBox "No existe la carpeta INVENTARIO"
Exit Sub
End If
'
arch = Range("L2") & " " & Format(Range("M2"), "dd-mm-yyyy")
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ruta & "\" & carpeta & "\" & arch & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
ActiveSheet.PrintOut Copies:=1
MsgBox "Hoja Impresa y guardada como PDF", vbInformation
End Sub
'
Function escritorio() As String
'Referencia: http://www.ozgrid.com/forum/showthread.php?t=24985
'Act.Por.Dante Amor
Dim objWSHShell As Object
Dim strSpecialFolderPath
On Error GoTo ErrorHandler
Set objWSHShell = CreateObject("WScript.Shell")
escritorio = objWSHShell.SpecialFolders("Desktop")
Set objWSHShell = Nothing
Exit Function
ErrorHandler:
escritorio = ""
End Function' : ) 'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias ' : )
Hola
Fíjate que ma erro en
ruta= escritorio()
lo cambie por la ruta donde esta la carpeta pero tambien me da error
ruta = "C:\Documents and Settings\MORALES\Escritorio"
esta macro me funciona pero no logro hacer que me aparezca la fecha a la par del nombre:
el nombre este en la celda L2 y la fecha en M2 ( o sea Cells(2, 12) y Cells(2, 13).
ActiveWindow.SelectedSheets.PrintOut Copies:=1
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Documents and Settings\MORALES\Escritorio\Inventario\" + Cells(2, 12) + ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
coloque la ruta asi
"C:\Documents and Settings\MORALES\Escritorio\Inventario\" + Cells(2, 12) + Cells(2, 13) + ".pdf"
pero no funciona
¿Qué mensaje de error te pone?
Tienes la instrucción "Explit option", entonces quita esa instrucción y vuelve a probar.
¿Pusiste todo el código dentro de tu formulario?
Revisa que hayas copiado la macro del commmandbutton y la función "escritorio"
¿Cambiaste algo en las macros?
Si resolviste el problema, no olvides valorar, si todavía tienes problemas, entonces envíame la información solicitada.
La macro que te envié es más completa, ya que te valida la existencia de las carpetas, pero también puedes ocupar tu macro si estás seguro de que existen las carpetas.
Entonces cambia en tu macro esta línea:
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "C:\Documents and Settings\MORALES\Escritorio\Inventario\" + Cells(2, 12) + ".pdf", Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _ True
Por estas:
ruta = "C:\Documents and Settings\MORALES\Escritorio\Inventario\" arch = Cells(2, 12) & Format(Cells(2, 13), "dd-mm-yyyy") & ".pdf" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _ Filename:=ruta & arch, Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
nota: la fecha en el nombre del archivo tiene que ponerse con guiones "-" ya que la diagonal "/" es un carácter no permitido en un nombre de archivo.
' : ) 'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias ' : )
