[RESUELTO] Copiar rangos todos los documentos de una carpeta

Desarrollo de Macros y programación en UNO, usar las API, llamar programas externos...

[RESUELTO] Copiar rangos todos los documentos de una carpeta

Notapor Jose3 » Dom Oct 27, 2019 12:04 pm

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   Expandir vistaContraer vista
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
Última edición por Jose3 el Sab Nov 02, 2019 12:38 pm, editado 1 vez en total
OpenOffice 4.1.6 sobre Windows 10 Home + LibreOffice 6.2 sobre Manjaro en dual boot
Jose3
 
Mensajes: 5
Registrado: Jue Jun 27, 2019 9:52 pm

Re: Copiar rangos de todos los documentos de una carpeta

Notapor mauricio » Lun Oct 28, 2019 7:21 am

El código mostrado por acá, hace "casi" exactamente esto, pero hace uso de una extensión:

viewtopic.php?f=21&t=14571&p=65047#p65011
______________________________________________
"Todo cuanto no podemos dar nos posee". - André Gide
LibreOffice 6.2 | ArchLinux | Gnome3
No respondo preguntas privadas, por favor, usa el foro
Avatar de Usuario
mauricio
 
Mensajes: 5966
Registrado: Sab Nov 22, 2008 5:36 am
Ubicación: CDMX

Re: Copiar rangos de todos los documentos de una carpeta

Notapor Jose3 » Lun Oct 28, 2019 11:07 am

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
OpenOffice 4.1.6 sobre Windows 10 Home + LibreOffice 6.2 sobre Manjaro en dual boot
Jose3
 
Mensajes: 5
Registrado: Jue Jun 27, 2019 9:52 pm

Re: Copiar rangos de todos los documentos de una carpeta

Notapor mauricio » Lun Oct 28, 2019 4:04 pm

De todos modos no funciona en OepnOffice :lol:

Si el código que muestras te funciona bien, no lo toques. :D
______________________________________________
"Todo cuanto no podemos dar nos posee". - André Gide
LibreOffice 6.2 | ArchLinux | Gnome3
No respondo preguntas privadas, por favor, usa el foro
Avatar de Usuario
mauricio
 
Mensajes: 5966
Registrado: Sab Nov 22, 2008 5:36 am
Ubicación: CDMX

Re: Copiar rangos de todos los documentos de una carpeta

Notapor fornelasa » Lun Oct 28, 2019 6:24 pm

A mi personalmente me sigue gustando mucho el dispatcher con el Copy y el Paste.

Código: Seleccionar todo   Expandir vistaContraer vista
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   Expandir vistaContraer vista
Dim mDummy(0) As New com.sun.star.beans.PropertyValue 
     mDummy(0).Name = "Hidden"
    mDummy(0).Value = True
lo 6.2.0 | aoo 4.1.6 | win 7/10
¡Un aplauso para todos los que luchan por proteger y promover la Web abierta!
Avatar de Usuario
fornelasa
 
Mensajes: 3246
Registrado: Jue Feb 17, 2011 8:30 pm
Ubicación: Estado de México, México.

Re: Copiar rangos de todos los documentos de una carpeta

Notapor Jose3 » Dom Nov 03, 2019 9:40 am

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   Expandir vistaContraer vista
  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
OpenOffice 4.1.6 sobre Windows 10 Home + LibreOffice 6.2 sobre Manjaro en dual boot
Jose3
 
Mensajes: 5
Registrado: Jue Jun 27, 2019 9:52 pm

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

Notapor mauricio » Dom Nov 03, 2019 7:44 pm

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.
______________________________________________
"Todo cuanto no podemos dar nos posee". - André Gide
LibreOffice 6.2 | ArchLinux | Gnome3
No respondo preguntas privadas, por favor, usa el foro
Avatar de Usuario
mauricio
 
Mensajes: 5966
Registrado: Sab Nov 22, 2008 5:36 am
Ubicación: CDMX

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

Notapor Jose3 » Dom Nov 03, 2019 10:05 pm

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.
OpenOffice 4.1.6 sobre Windows 10 Home + LibreOffice 6.2 sobre Manjaro en dual boot
Jose3
 
Mensajes: 5
Registrado: Jue Jun 27, 2019 9:52 pm

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

Notapor fornelasa » Lun Nov 04, 2019 5:40 pm

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   Expandir vistaContraer vista
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
lo 6.2.0 | aoo 4.1.6 | win 7/10
¡Un aplauso para todos los que luchan por proteger y promover la Web abierta!
Avatar de Usuario
fornelasa
 
Mensajes: 3246
Registrado: Jue Feb 17, 2011 8:30 pm
Ubicación: Estado de México, México.

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

Notapor Jose3 » Mar Nov 05, 2019 10:16 am

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   Expandir vistaContraer vista
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   Expandir vistaContraer vista
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é.
OpenOffice 4.1.6 sobre Windows 10 Home + LibreOffice 6.2 sobre Manjaro en dual boot
Jose3
 
Mensajes: 5
Registrado: Jue Jun 27, 2019 9:52 pm


Volver a Macros y API UNO

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 3 invitados