Apache OpenOffice: Foro oficial de la comunidad

Los foros en español de la comunidad de Apache OpenOffice (y LibreOffice). En tu idioma desde el 2008, ayudándote a usar tu libertad.
https://forum.openoffice.org/es/forum/

[RESUELTO] Copiar rangos todos los documentos de una carpeta

https://forum.openoffice.org/es/forum/viewtopic.php?t=14635

Página 1 de 1

[RESUELTO] Copiar rangos todos los documentos de una carpeta

Publicado: Dom Oct 27, 2019 12:04 pm
por Jose3
Hola, he montado una macro en Basic que va abriendo todos los archivos calc que encuentra con un nombre determinado, detecta el rango de datos (nº de filas variable, nº de columnas constante) y después lo copia secuencialmente en el documento origen de la macro.
La macro funciona sin problemas, aunque debo añadirle algunas funcionalidades posteriormente (Ej. salvar el problema de una línea sin datos que invalide el rango); pero lo que me gustaría es que me dierais ideas para optimizar este código, ya que lo encuentro, digamos un poco "sucio" y estoy seguro que vais a sugerirme soluciones más elegantes.
Es obvio que solo conozco lo más básico de este lenguaje, así que si encontrais una barbaridad, no os corteis.
Una cosa más; disponía de tres métodos para realizar la copia: Como array de datos, con Dispatch y con insertTransferable. Escogí esta última porque me pareció la más simple y que además no usaba el portapapeles (en el entorno en el que pienso usar es preferible evitar el clipboard) pero si creeis que por rendimiento o por versatilidad para futuras funcionalidades es más práctico otro método, indicadmelo sin dudar que probaré todos los métodos.
Gracias de antemano.

Código: Seleccionar todo

REM*******BASIC********
Option Explicit
'Este procedimiento abre secuencialmente los archivos de una carpeta _
'y copia el rango de datos que encuentre en ellos, y que puede tener _
'un numero de filas variable, y los pega uno debajo de otro en el _
'documento destino.
'Todos los rangos tienen el mismo numero de columnas (campos)
sub CpRng_Archivos_Carpeta
    Dim oDocOrigen as Object
    Dim oHojaOrigen as Object
    Dim oCeldaOrigen as Object
    Dim oCeldaDestino as Object
    Dim oFilaFinalOrigen as integer
    Dim oColumnaFinal as integer
    Dim sRutaOrigen as String
    Dim sArchivoOrigen as String
    Dim mDummy()
    Dim oCursorOrigen as Object
    Dim oCursorDestino as Object
    Dim oFilaLibre as integer
    Dim oTransferible as Object
    Dim sRutaDestino as String
    Dim oDocDestino as Object
    Dim oRango as Object
    Dim oRangoTrans as Object
    '=======================================
    'Inicializamos
    sRutaOrigen = "D:\Documentos\Laboratorio\lab_openoffice\Archivos_prueba\"
    sArchivoOrigen = Dir(sRutaOrigen & "pruebas?.ods")
    oDocDestino = ThisComponent

    'Abrimos archivos
    Do While sArchivoOrigen <> "" 
        oDocOrigen = StarDesktop.loadComponentFromUrl(convertToUrl(sRutaOrigen & sArchivoOrigen), "_blank", 6, mDummy())
        oHojaOrigen = oDocOrigen.Sheets(0)
        oCeldaOrigen = oHojaOrigen.getCellRangeByName("A1")
        oCursorOrigen = oHojaOrigen.createCursorByRange(oCeldaOrigen)
        oCursorOrigen.GotoEndOfUsedArea(true)
        oFilaFinalOrigen = oCursorOrigen.getRangeAddress().endRow()
        oColumnaFinal = oCursorOrigen.getRangeAddress.endColumn()
        oRango = oHojaOrigen.getCellRangeByPosition(0, 0, oColumnaFinal, oFilaFinalOrigen)
        oDocOrigen.currentController.select(oRango)
        oRangoTrans = oDocOrigen.currentController.getTransferable()
        oCeldaDestino = oDocDestino.Sheets(0).getCellRangeByName("A1")
        oCursorDestino = oDocDestino.Sheets(0).createCursorByRange(oCeldaDestino)
        oCursorDestino.GotoEndOfUsedArea(true)
        oFilaLibre = oCursorDestino.getRangeAddress.endRow + 2
        oRango = oDocDestino.Sheets(0).getCellRangeByName("a"+ oFilaLibre)
        oDocDestino.currentController.select(oRango)
        oDocDestino.currentController.insertTransferable(oRangoTrans)
        oDocDestino.store()
        oDocOrigen.store()
        oDocOrigen.close(true)
        sArchivoOrigen = Dir
    loop
end sub

Re: Copiar rangos de todos los documentos de una carpeta

Publicado: Lun Oct 28, 2019 7:21 am
por mauricio
El código mostrado por acá, hace "casi" exactamente esto, pero hace uso de una extensión:

https://forum.openoffice.org/es/forum/v ... 047#p65011

Re: Copiar rangos de todos los documentos de una carpeta

Publicado: Lun Oct 28, 2019 11:07 am
por Jose3
Muchas gracias Mauricio, pero en el entorno en el que usaré OpenOffice no me permiten instalar Python, ni siquiera LibreOffice, ya lo había preguntado. No obstante, la voy a probar en casa, que aquí la única que manda es mi esposa y sí me deja. :D

Re: Copiar rangos de todos los documentos de una carpeta

Publicado: Lun Oct 28, 2019 4:04 pm
por mauricio
De todos modos no funciona en OepnOffice :lol:

Si el código que muestras te funciona bien, no lo toques. :D

Re: Copiar rangos de todos los documentos de una carpeta

Publicado: Lun Oct 28, 2019 6:24 pm
por fornelasa
A mi personalmente me sigue gustando mucho el dispatcher con el Copy y el Paste.

Código: Seleccionar todo

Sub macenDirs()
         octrl = ThisComponent.currentController        
     odocument = octrl.Frame
         ohoja = octrl.activeSheet
       ocursor = ohoja.createCursorByRange(ohoja.getCellRangeByName("A1"))                  
           url = ConvertToURL("C:\Users\Federico\Downloads\aaa\")  'PON TU RUTA CORRECTA       
      archivos = Dir(url & "*.ods", 0) 'USA TU PARAMETRO CORRECTO         
      Dim a(0) As New com.sun.star.beans.PropertyValue  
     a(0).Name = "Hidden" 
    a(0).Value = True
    While archivos <> ""
           oDoc = StarDesktop.LoadComponentFromUrl(url & archivos, "_blank" , 0, a())
     document = oDoc.CurrentController.Frame
   dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
         ctrl = oDoc.currentController
         hoja = ctrl.activeSheet
        cursor = hoja.createCursorByRange(hoja.getCellRangeByName("A1"))
        cursor.collapseToCurrentRegion()
           uf = cursor.rangeAddress.endRow + 2                     
          ctrl.Select(hoja.getCellRangeByName("A1:D" & uf - 1)                
    dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())        
       ocursor.collapseToCurrentRegion()                 
          octrl.Select(ohoja.getCellByPosition(0, ocursor.rangeAddress.endRow + 1)    
    dispatcher.executeDispatch(odocument, ".uno:Paste", "", 0, Array())
     oDoc.Close(True)       
     archivos = Dir()
    Wend
    ohoja.getColumns.OptimalWidth = true
  dim args1(0) as new com.sun.star.beans.PropertyValue
  args1(0).Name = "Sel"
  args1(0).Value = false
dispatcher.executeDispatch(odocument, ".uno:GoToStart", "", 0, args1())  
 End Sub
No creo que pueda optimizarse más tu código, es decir, bueno si un poco, por ejemplo usar un dataArray con un setDataArray(datos) y de esa manera evitas el PortaPapeles y el Select.

En tu código, para disminuir el "parpadeo"
Usa

Código: Seleccionar todo

Dim mDummy(0) As New com.sun.star.beans.PropertyValue  
     mDummy(0).Name = "Hidden" 
    mDummy(0).Value = True

Re: Copiar rangos de todos los documentos de una carpeta

Publicado: Dom Nov 03, 2019 9:40 am
por Jose3
Te ruego que me disculpes, pero después de haber dado por resuelto el tema tengo una duda. Llevo literalmente dos días buscando en la documentación, revisando los libros de Mauricio y de Pitonyak, el foro en español y en inglés y... no consigo encontrar el modo de obtener los argumentos que pueda o no llevar un comando Dispatch.
¿Podrías orientarme?
Un cordial saludo.

Código: Seleccionar todo

  dim args1(0) as new com.sun.star.beans.PropertyValue
  args1(0).Name = "Sel"
  args1(0).Value = false
dispatcher.executeDispatch(odocument, ".uno:GoToStart", "", 0, args1())  
 End Sub

Re: [RESUELTO]Copiar rangos todos los documentos de una carp

Publicado: Dom Nov 03, 2019 7:44 pm
por mauricio
El 99% de lo que se puede hacer con Dispatch, se puede hacer sin el, yo siempre recomiendo solo usarlo solo en ese 1% restante, por alguna razón, a muchos se les hace más cómodo. Cualquier argumento requerido dependerá del comando a usar y no hay una lista para ello.

Re: [RESUELTO]Copiar rangos todos los documentos de una carp

Publicado: Dom Nov 03, 2019 10:05 pm
por Jose3
Gracias Mauricio, ya me he dado cuenta a golpes. Pero es que soy un poco terco y quería documentar en mis apuntes las tres formas de copiar rangos de un documento a otro que aparecen en el libro de Pitonyak. Ya lo he hecho y, efectivamente, cualquiera de los otros dos métodos es más limpio (y me ha dado la sensación de que más rápidos) y mjor documentado.
Cuando termine con los Dialogos empezaré a ver esto desde el punto de vista de Python.

Re: [RESUELTO] Copiar rangos todos los documentos de una car

Publicado: Lun Nov 04, 2019 5:40 pm
por fornelasa
Hola, Se comentó:
por ejemplo usar un dataArray con un setDataArray(datos) y de esa manera evitas el PortaPapeles y el Select.
Aquí no usamos el Dispatcher

Código: Seleccionar todo

Sub macenDirs()
         octrl = ThisComponent.currentController
         ohoja = octrl.activeSheet
           oA1 = ohoja.getCellRangeByName("A1")
                    
           url = ConvertToURL("C:\Users\Federico\Downloads\aaa\")    'USA TU RUTA CORRECTA
      archivos = Dir(url & "*.ods", 0)  'USA TU PARÁMETRO CORRECTO
            
      Dim a(0) As New com.sun.star.beans.PropertyValue  
     a(0).Name = "Hidden" 
    a(0).Value = True
           
       headers = Array(Array("Columna 1", "Columna 2", "Columna 3", "Columna X"))
    
    While archivos <> ""
          oDoc = StarDesktop.LoadComponentFromUrl(url & archivos, "_blank" , 0, a())
          ctrl = oDoc.currentController
          hoja = ctrl.activeSheet
           pA1 = hoja.getCellRangeByName("A1")                       
        cursor = hoja.createCursorByRange(pA1)
         cursor.collapseToCurrentRegion()
            uf = cursor.rangeAddress.endRow + 1
           hoja.getCellRangeByName("D2").String = oDoc.Title
           hoja.getCellRangeByName("D2:D" & uf).fillAuto(com.sun.star.sheet.FillDirection.TO_BOTTOM, 1 )          
         datos = hoja.getCellRangeByName("A2:D" & uf).dataArray         
       ocursor = ohoja.createCursorByRange(oA1)           
       ocursor.collapseToCurrentRegion()
          puf = ocursor.rangeAddress.endRow + 1
      ohoja.getCellRangeByName("A" + (puf + 1) + ":D" + (puf + uf - 1 )).setDataArray(datos)                 
    oDoc.Close(True)       
     archivos = Dir()
    Wend
    
    ohoja.getCellRangeByName("A1:D1").setDataArray(headers)    
    ohoja.getColumns.OptimalWidth = true
	MsgBox "Proceso concluido"	
	
	 '  ohoja.getRows().removeByIndex(0,1)
	 
End Sub

Re: [RESUELTO] Copiar rangos todos los documentos de una car

Publicado: Mar Nov 05, 2019 10:16 am
por Jose3
Sí, he probado los tres métodos, con array de datos lo hice como en la macro de más abajo, pero me interesó más el método con getTransferable() porque mantiene el formato y con arrays tienes que formatear, previa o posteriormente, las columnas de fechas (por ejemplo).
Interpreté el método con arrays así:

Código: Seleccionar todo

sub CpRng_Archivos_Carpeta
    Dim oDocOrgn as Object
    Dim oHojaOrgn as Object
    Dim sUrlOrgn as string
    Dim oFilaFinalOrgn as long
    Dim oColumnaFinalOrgn as long
    Dim oFilaDstn as long
    Dim oColumnaDstn as long
    Dim sCarpetaOrgn as string
    Dim oDocDstn as Object
    Dim oHojaDstn as Object
    Dim oCursorOrgn as Object
    Dim oCursorDstn as Object
    Dim mProp(0) as New com.sun.star.beans.PropertyValue
    Dim oRango as Object
    Dim oDatos as Object
    '============================================================
    oDocDstn = ThisComponent
    oHojaDstn = oDocDstn.Sheets(0)
    oCursorDstn = oHojaDstn.createCursorByRange(oHojaDstn.getCellRangeByName("A1"))
    sCarpetaOrgn = "D:\Documentos\Laboratorio\lab_openoffice\Archivos_prueba\"
    sUrlOrgn = Dir(sCarpetaOrgn & "pruebas?.ods")
    mProp(0).Name = "Hidden"
    mProp(0).Value = true

    Do While sUrlOrgn <> ""
        oDocOrgn = StarDesktop.loadComponentFromUrl(convertToUrl(sCarpetaOrgn & sUrlOrgn), "_blank", 6, mProp())
        oHojaOrgn = oDocOrgn.Sheets(0)
        oCursorOrgn = oHojaOrgn.createCursorByRange(oHojaOrgn.getCellRangeByName("A1"))
        oCursorOrgn.GoToEndOfUsedArea(true)
        oFilaFinalOrgn = oCursorOrgn.getRangeAddress().endRow
        oColumnaFinalOrgn = oCursorOrgn.getRangeAddress().endColumn
        oRango = oHojaOrgn.getCellRangeByPosition(0,0,oColumnaFinalOrgn,oFilaFinalOrgn)
        oDatos = oRango.getDataArray()
        oCursorDstn.GoToEndOfUsedArea(true)
        oFilaDstn = oCursorDstn.getRangeAddress.endRow + 1
        oColumnaDstn = oColumnaFinalOrgn
        oRango = oHojaDstn.getCellRangeByPosition(0,oFilaDstn,oColumnaDstn, oFilaDstn + oFilaFinalOrgn)
        oRango.setDataArray(oDatos)
        oDocDstn.store()
        oDocOrgn.close(true)
        sUrlOrgn = Dir
    Loop
end sub
Y con XTransferableSupplier así:

Código: Seleccionar todo

REM*******BASIC********
Option Explicit
'Este procedimiento abre secuencialmente los archivos de una carpeta _
'y copia el rango de datos que encuentre en ellos, y que puede tener _
'un numero de filas variable, y los pega uno debajo de otro en el _
'documento destino.
'Todos los rangos tienen el mismo numero de columnas (campos)
sub CpRng_Archivos_Carpeta
    Dim oDocOrigen as Object
    Dim oHojaOrigen as Object
    Dim oCeldaOrigen as Object
    Dim oCeldaDestino as Object
    Dim oFilaFinalOrigen as integer
    Dim oColumnaFinal as integer
    Dim sRutaOrigen as String
    Dim sArchivoOrigen as String
    Dim mDummy()
    Dim oCursorOrigen as Object
    Dim oCursorDestino as Object
    Dim oFilaLibre as integer
    Dim oTransferible as Object
    Dim sRutaDestino as String
    Dim oDocDestino as Object
    Dim oRango as Object
    Dim oRangoTrans as Object
    '=======================================
    'Inicializamos
    sRutaOrigen = "D:\Documentos\Laboratorio\lab_openoffice\Archivos_prueba\"
    sArchivoOrigen = Dir(sRutaOrigen & "pruebas?.ods")
    oDocDestino = ThisComponent

    'Abrimos archivos
    Do While sArchivoOrigen <> "" 
        oDocOrigen = StarDesktop.loadComponentFromUrl(convertToUrl(sRutaOrigen & sArchivoOrigen), "_blank", 6, mDummy())
        oHojaOrigen = oDocOrigen.Sheets(0)
        oCeldaOrigen = oHojaOrigen.getCellRangeByName("A1")
        oCursorOrigen = oHojaOrigen.createCursorByRange(oCeldaOrigen)
        oCursorOrigen.GotoEndOfUsedArea(true)
        oFilaFinalOrigen = oCursorOrigen.getRangeAddress().endRow()
        oColumnaFinal = oCursorOrigen.getRangeAddress.endColumn()
        oRango = oHojaOrigen.getCellRangeByPosition(0, 0, oColumnaFinal, oFilaFinalOrigen)
        oDocOrigen.currentController.select(oRango)
        oRangoTrans = oDocOrigen.currentController.getTransferable()
        oCeldaDestino = oDocDestino.Sheets(0).getCellRangeByName("A1")
        oCursorDestino = oDocDestino.Sheets(0).createCursorByRange(oCeldaDestino)
        oCursorDestino.GotoEndOfUsedArea(true)
        oFilaLibre = oCursorDestino.getRangeAddress.endRow + 2
        oRango = oDocDestino.Sheets(0).getCellRangeByName("a"+ oFilaLibre)
        oDocDestino.currentController.select(oRango)
        oDocDestino.currentController.insertTransferable(oRangoTrans)
        oDocDestino.store()
        oDocOrigen.store()
        oDocOrigen.close(true)
        sArchivoOrigen = Dir
    loop
end sub
Son algo rústicas pero me sirven de guía. No me he parado a repasarlas pero creo que en alguna hay declarada alguna variable que luego no usé.
Todos los horarios son UTC+01:00
Página 1 de 1

Desarrollado por phpBB® Forum Software © phpBB Limited

Traducción al español por phpBB España