domingo, 17 de junio de 2012

VBA: Macro para imprimir los WorkBooks de una carpeta.

Hoy veremos una macro sencilla, que utiliza algunas funciones de VBA muy interesantes, así como algún método o propiedad; y todo con el fín de obtener una impresión de la Hoja1 de todos los ficheros Excel de una carpeta dada. Esta impresión podrá ser bien en papel o bien, si disponemos del software oportuno, directamente en un fichero .pdf.
Supondremos que deseamos imprimir los ficheros de excel que se encuentren en la carpeta D:\Prueba\, y que para nuestro ejemplo, aprovecharemos la aplicación PrimoPDF, para obtener de la Hoja1 de todos los Libros de trabajo de Excel de esas carpeta, el rango seleccionada como área de impresión.

Insertaremos en un módulo del Explorador de proyectos del Editor de VBA el siguiente código, formando nuestra macro de Excel:

Sub Imprimir_Otro_Workbook()
Dim Ruta, Archivos As String
Ruta = "D:\Prueba\"
'representa el nombre de un archivo, directorio
'o carpeta que coincide con el patrón o atributo de archivo especificado
Archivos = Dir(Ruta & "\*.xl*")

Application.ScreenUpdating = False
'Recorremos la carpeta o directorio hasta el último archivo con extensión .xl*
Do While Len(Archivos) > 0
   'Abrimos los WorkBook de la carpeta
   Workbooks.Open Filename:=Ruta & "\" & Archivos
   'Damos la orden de imprimir la Hoja1 del Libro,
   'activando una de las impresores disponibles
   ActiveWorkbook.Sheets(1).PrintOut Copies:=1, ActivePrinter:="PrimoPDF", _
   IgnorePrintAreas:=False
   'Cerramos el WorkBook abierto sin guardar cambios
   ActiveWorkbook.Close savechanges:=False
   'Para obtener más nombres de archivo que coincidan con la Ruta,
   'volveremos a llamar a la función Dir sin argumentos
   Archivos = Dir()
Loop
Application.ScreenUpdating = True
End Sub


La clave de esta macro es la función Dir (ya empleada en est blog), y que nos devuelve una variable, tipo String, que representa el nombre de un archivo, directorio o carpeta que coincide con el patrón o atributo de archivo especificado, o la etiqueta de volumen de una unidad de disco. Con una gran vengtaja, y es que la función Dir permite el empleo de los caracteres comodín '*' (múltiples caracteres) y '?' (un solo carácter) para especificar varios archivos. Además Dir devuelve el primer nombre de archivo que coincide con la Ruta. Para obtener más nombres de archivo que coincidan con la Ruta, volveremos a llamar a la función Dir sin argumentos, esto es, Dir().
Por otro lado empleamos el método Workbooks.Open con su parámetro Filename para abrir los Libros de trabajo (WorkBooks) de la carpeta concreta definida con la función Dir.
También usaremos para configurar la impresión el método ActiveWorkbook.Sheets(1).PrintOut, y sus parámetros Copies,ActivePrinter y IgnorePrintAreas; destacando como clave el parámetro ActivePrinter, con el que indicaremos qué impresora de las existentes deseamos utilizar.
Finalizamos señalando que una vez abierto el Libro de trabajo de Excel, impresa la Hoja1, sólo cabe cerrar el Libro sin guardar cambios, lo que conseguimos con el método ActiveWorkbook.Close y su parámetro savechanges:=False que evita la ventana diálogo de pregunta de si Guardar o No guardar.

9 comentarios:

  1. son muy buenos tus ejemplos y la ayuda que das con ellos. En mi caso tome este codigo y quise combinarlo con este otro http://excelforo.blogspot.mx/2012/10/vba-macro-para-abrir-y-cerrar-un-libro.html.
    lo que quiero es de una carpeta abrir todos los excel con varias hojas y agarrar el mismo rango de todas y copiarlo al excel donde esta el macro.
    tengo echo este codigo.

    Sub Copiartodo()
    Dim Ruta, Archivos As String
    Dim celdadestino As Range

    Ruta = "C:\Users\Veronica\Desktop\abrir\"

    Archivos = Dir(Ruta & "\*.xl*")

    Do While Len(Archivos) > 0
    Workbooks.Open Filename:=Ruta & "\" & Archivos
    Worksheets("RESULTADOS").Activate

    Set tbl = Range("A6").CurrentRegion

    Set celdadestino = Workbooks("resul.xlsm").Sheets("TOTAL").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

    tbl.Offset(3, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Copy _
    Destination:=Workbooks("resul.xlsm").Sheets("TOTAL").Range(celdadestino.Address)

    Application.CutCopyMode = False

    Workbooks(Archivos).Close savechanges:=False

    Archivos = Dir()
    Loop
    Application.ScreenUpdating = True
    End Sub

    funsiona al abrir el primer libro pero al abrir el segundo me marca error en --- Worksheets("RESULTADOS").Activate----
    todos los libros son iguales lo unico que cambia es la informacion que tienen. Si puedes echarme una mano te lo agradeceria mucho.
    Gracias.

    ResponderEliminar
    Respuestas
    1. Hola Darwin,
      te has asegurado que existe la hoja 'RESULTADOS' en todos los ficheros???
      El resto parece correcto...
      Slds

      Eliminar
  2. que tal Ismael, saludos.
    así es todos los ficheros tienes esa hoja, de echo todos son iguales solo cambia en la información de las celdas y obvio en el nombre del libro. Mi intención es copiar esa hoja de todos los ficheros en un libro nuevo para tener un resumen mensual.

    ResponderEliminar
    Respuestas
    1. Hola,
      la idea es copiar y pegar el contenido de cada hoja 'RESULTADOS' de cada libro de la carpeta
      C:\Users\Veronica\Desktop\abrir\
      en el libro resul.xlsm en la hoja TOTAL, una debajo de otra...
      correcto?
      Y te falla en la línea de activar la hoja RESULTADOS .. funcionando la primera vez.. es raro, pero cambia:
      Worksheets("RESULTADOS").Activate
      Set tbl = Range("A6").CurrentRegion
      por
      Set tbl = Worksheets("RESULTADOS").Range("A6").CurrentRegion
      a ver qué pasa.
      Saludos

      Eliminar
    2. que tal Israel buen día.
      ya hice lo que me dijiste y el error se sigue mostrando.
      pero he detectado otro error, al parecer el código que te mostré jala la información de las hojas de los diferentes libros pero no jala los valores, sino las formulas q tiene cada celda.
      a ver si me puedo explicar. Lo que pasa es que de los libros que tengo la hoja con la que quiero trabajar (RESULTADOS) es una recolección de las hojas anteriores. y por eso es pura formula prácticamente. y al momento de que el código jala la información toma la formula no el valor en si y me muestra la información de unos datos que en la hoja RESULTADOS ya los he borrado pero si están en otro hoja anterior.
      me podrías dar un correo electrónico para enviarte los libros y los revises a ver si tu le hallas el problema?

      De antemano muchas gracias.

      Eliminar
    3. Hola Darwin,
      yo probaría con un copiado y pegado de valores (en lugar de como lo tienes ahora que arrastra las fórmulas).

      Para enviarme los ficheros lee las Normas de Uso del blog y condiciones y si es´tas conforme con ellas, envíame lo que tengas.

      Saludos

      Eliminar
    4. Que tal Ismael. saludos
      Ya resolví el problema, me puse a leer sobre el error que marcaba.
      El detalle era que el archivo resul estaba en la misma carpeta donde están los otros archivos, entonces en pocas palabras el código abría un archivo ya abierto y que aparte no tiene la hoja RESULTADOS. isa que lo único que hice fue quitar el archivo resul de esa carpeta y listo, problema resuelto.
      muchas gracias por tu ayuda.

      Eliminar
  3. Hola buena día!
    Disculpa, me encuentro con un problema o duda, después de tener una macro que abre archivos y copia datos que le pedí , deseo que se cierren todos los archivos que abrí a excepción del archivo en donde estoy copiando los datos que busqué en los demás archivos, pero hasta el final de hacer todo el proceso,porqué he comprobado que el proceso es mas rápido que en vez de estar abriendo, buscando, copiando y cerrando. Espero me puedas ayudar con eso. Gracias

    ResponderEliminar
    Respuestas
    1. Hola,
      podría ser algo así:

      Sub CerrarWBs()
      Dim WBk As Workbook
      Application.ScreenUpdating = False
      For Each WBk In Application.Workbooks
      If Not (WBk Is Application.ActiveWorkbook) Then
      WBk.Close
      End If
      Next WBk
      Application.ScreenUpdating = True
      End Sub


      podrías añadir también la acción de guardado .Save

      Saludos

      Eliminar

Nota: solo los miembros de este blog pueden publicar comentarios.