Guardar como pdf área de impresión con PDFCREATOR

Me gustaría agregarle a un botón una macro para que al apretar el mismo me guarde el área de impresión que seleccione como pdf, usando pdf creator, en office 2003.

Pero, a su ves, que la paginas en blanco las elimine.

Es decir, como por ejemplo.

Yo marco como área de impresión de la celda Fila A1 D1, hasta A1000 D1000.

Pero solo ingrese datos desde A1 D1, hasta A50 D50, entonces no quiero que me guarde toda las otras celdas como pdf generándome mas hojas.

Saludos espero que puedan ayudarme y haber sido al menos un poco claro.

1 Respuesta

Respuesta
1

Como PDFCreator, es la simulación de una impresora, tienes que elegirla como impresora para enviar el documento.

Se me ocurre la siguiente macro, para que puedas seleccionar PDFCreator y que te imprima el área que solamente tienes datos.

Sigue las Instrucciones para un botón y ejecutar la macro
1. Abre tu libro de Excel
2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
3. En el menú elige Insertar / Módulo
4. En el panel del lado derecho copia la macro
5. Ahora para crear un botón, puedes hacer lo siguiente:
6. Inserta una imagen en tu libro, elige del menú Insertar / Imagen / Autoformas
7. Elige una imagen y con el Mouse, dentro de tu hoja, presiona click y arrastra el Mouse para hacer grande la imagen.
8. Una vez que insertaste la imagen en tu hoja, dale click derecho dentro de la imagen y selecciona Asignar macro / Selecciona: imprimir
9. Aceptar.
10. Para ejecutarla dale click a la imagen.

Sub imprimir()
'Por.DAM
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    ActiveSheet.UsedRange.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    hoja = ActiveSheet.Name
    ImpresoraActual = Application.ActivePrinter
    Application.Dialogs(xlDialogPrinterSetup).Show
    ActiveSheet.PrintOut Copies:=1, Collate:=True
    Application.ActivePrinter = ImpresoraActual
    Sheets(hoja).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Si tienes PDFCreator como impresora predeterminada, utiliza esta macro.

Sub imprimir()
'Por.DAM
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    ActiveSheet.UsedRange.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    hoja = ActiveSheet.Name
    ActiveSheet.PrintOut Copies:=1, Collate:=True
    Sheets(hoja).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Prueba ambas y me comentas.

Saludos. DAM
Si es lo que necesitas.

Dam, te envío un archivo de ejemplo.

No tengo el pdf creator como predeterminado ya que uso otra impresora.

Hay un inconveniente en la macro por que no me respeta el área de impresión que yo marque, como también me acorta columnas, y me abre otra hoja.

https://www.dropbox.com/s/yoqp8sv06p6fnlc/El%20Galgo%20experto.xls

saludos

La hoja que se crea es para imprimir solamente lo seleccionado y al final de la macro se borra.

Prueba con esta macro

Sub Rectángulo_Haga_clic_en()
'Por.DAM
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    rango = ActiveSheet.PageSetup.PrintArea
    If rango = "" Then Exit Sub
    i = Range(rango).Cells(1, 1).Row
    f = Range(rango).Rows.Count + i - 1
    c = Range(rango).Cells(1, 1).Column
    d = Range(rango).Columns.Count + c - 1
    For j = c To d
        uf = Cells(Rows.Count, j).End(xlUp).Row
        If uf > ux Then ux = uf
    Next
    Set rango2 = Range(Cells(i, c), Cells(ux, d))
    rango2.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    hoja = ActiveSheet.Name
    ImpresoraActual = Application.ActivePrinter
    Application.Dialogs(xlDialogPrinterSetup).Show
    ActiveSheet.PrintOut Copies:=1, Collate:=True
    Application.ActivePrinter = ImpresoraActual
    Sheets(hoja).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Prueba y me comentas, si no funciona revisamos otras opciones
Saludos. DAM
Si es lo que necesitas.

Dam. sigue ocurriendo el error que me achica las columnas , es como que me las deja con el ancho predeterminado en ves de dejarlas con la medida que yo elijo.

Por otro lado me abre la hoja 3 y después no me vuelve a la hoja que estaba trabajando.

Dam, la idea de esta macro es poder usarla para todos los libros en los cuales estoy trabajando no solo en el ejemplo...

Un abrazo gracias por tu esfuerzo...

Listo, prueba con esta

Sub Rectángulo_Haga_clic_en()
'Por.DAM
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim cols As New Collection
Set h1 = ActiveSheet
    rango = ActiveSheet.PageSetup.PrintArea
    If rango = "" Then Exit Sub
    i = Range(rango).Cells(1, 1).Row
    f = Range(rango).Rows.Count + i - 1
    c = Range(rango).Cells(1, 1).Column
    d = Range(rango).Columns.Count + c - 1
    For j = c To d
        uf = Cells(Rows.Count, j).End(xlUp).Row
        ancho = h1.Cells(i, j).ColumnWidth
        cols.Add ancho
        If uf > ux Then ux = uf
    Next
    Set rango2 = Range(Cells(i, c), Cells(ux, d))
    rango2.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    n = 1
    For j = 1 To cols.Count
        ancho = cols(j)
        Columns(n).ColumnWidth = cols(j)
        n = n + 1
    Next
    hoja = ActiveSheet.Name
    ImpresoraActual = Application.ActivePrinter
    Application.Dialogs(xlDialogPrinterSetup).Show
    ActiveSheet.PrintOut Copies:=1, Collate:=True
    Application.ActivePrinter = ImpresoraActual
    Sheets(hoja).Delete
h1.Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Saludos.DAM
No olvides finalizar la pregunta.

Dam, no me toma el área de impresión seleccionada.


En este caso donde el ejemplo es el área de impresión A7 C15, me toma las columna ABC completas, en ves de tomarme solo las celdas que yo seleccione.

El ancho de las columnas se soluciono, como también que dejaba abierta otra hoja.

Te envío el archivo para que lo veas.

https://www.dropbox.com/s/26si070yb4edrso/El%20Galgo%20experto1.xls


Saludos.

Cambio la macro por esta.

Sub Rectángulo_Haga_clic_en()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim cols As New Collection
Set h1 = ActiveSheet
    rango = ActiveSheet.PageSetup.PrintArea
    If rango = "" Then Exit Sub
    i = Range(rango).Cells(1, 1).Row
    f = Range(rango).Rows.Count + i - 1
    c = Range(rango).Cells(1, 1).Column
    d = Range(rango).Columns.Count + c - 1
    For j = c To d
        uf = Cells(Rows.Count, j).End(xlUp).Row
        ancho = h1.Cells(i, j).ColumnWidth
        cols.Add ancho
        If uf > ux Then ux = uf
    Next
    If uf > f Then uf = f
    Set rango2 = Range(Cells(i, c), Cells(ux, d))
    rango2.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
    n = 1
    For j = 1 To cols.Count
        ancho = cols(j)
        Columns(n).ColumnWidth = cols(j)
        n = n + 1
    Next
    hoja = ActiveSheet.Name
    ImpresoraActual = Application.ActivePrinter
    Application.Dialogs(xlDialogPrinterSetup).Show
    ActiveSheet.PrintOut Copies:=1, Collate:=True
    Application.ActivePrinter = ImpresoraActual
    Sheets(hoja).Delete
h1.Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

No olvides finalizar la pregunta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas