Manipulando rangos

From Apache OpenOffice Wiki
< ES‎ | Manuales‎ | GuiaAOO‎ | TemasAvanzados‎ | Macros‎ | StarBasic‎ | TrabajandoConCalc
Revision as of 11:48, 18 March 2013 by Salva (Talk | contribs)

(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to: navigation, search


Editing.png Esta página está en estado borrador.

En el capitulo anterior aprendimos a referenciar cualquier rango que nos interese, ahora, aprenderemos a manipular estos rangos, a moverlos, insertarlos, eliminarlos y copiarlos.


Moviendo rangos

Para mover un rango, usamos el método moveRange de las hojas de calculo, este método requiere de dos argumentos, la celda superior izquierda (CellAddress) destino donde se moverá el rango origen (CellRangeAddress)


Hoja.moveRange( Destino As CellAddress, Origen As CellRangeAddress )


El siguiente ejemplo mueve el rango A1:B5 de la hoja activa, a la celda D10 de la misma hoja.


 Sub MoverRangos1()
 Dim oHojaActiva As Object
 Dim oOrigen As Object
 Dim oDestino As Object
 
     oHojaActiva = ThisComponent.getCurrentController().getActiveSheet()
     'Rango a mover
     oOrigen = oHojaActiva.getCellRangeByName( "A1:B5" )
     'Celda destino
     oDestino = oHojaActiva.getCellRangeByName( "D10" )
 
     'Movemos el rango
     oHojaActiva.moveRange( oDestino.getCellAddress(), oOrigen.getRangeAddress() )
 
 End Sub


Ten en cuenta que el rango origen tiene que ser un rango de celdas, que la celda destino tiene que ser una celda individual, que los datos del rango origen se borran y los datos del rango destino son reemplazados sin preguntarte por los datos origen y muy importante, si el rango contiene formulas, estas, no se actualizan a la nueva posición aun y cuando las referencias sean relativas, también, el rango origen cambia para adaptarse al rango destino, es decir, la referencia a dicho rango se actualizara automáticamente como lo puedes comprobar si muestras la dirección del rango origen, antes y después de moverse.


     MsgBox DireccionRango( oOrigen )
 
     'Movemos el rango
     oHojaActiva.moveRange( oDestino.getCellAddress(), oOrigen.getRangeAddress() )
 
     MsgBox DireccionRango( oOrigen )


Recuerda que la función DireccionRango, es personalizada y la hemos usado en los últimos temas vistos. Cuando usas getCellRangeByName, aun y cuando solo hagas referencia a una celda, puedes tener acceso a su propiedad geCellAddress, por lo que no tienes problemas en mover solo una celda como se ve en el siguiente ejemplo.


 Sub MoverRangos2()
 Dim oHojaActiva As Object
 Dim oOrigen As Object
 Dim oDestino As Object
 
     oHojaActiva = ThisComponent.getCurrentController().getActiveSheet()
     'Nota como hacemos la referencia para que sea un rango
     oOrigen = oHojaActiva.getCellRangeByName( "B2" )
     'Esta tiene que seguir siendo una sola celda
     oDestino = oHojaActiva.getCellRangeByName( "E5" )
 
     'Movemos el rango
     oHojaActiva.moveRange( oDestino.getCellAddress(), oOrigen.getRangeAddress() )
 
 End Sub


Por supuesto podemos validar que por lo menos el origen y el destino sean efectivamente los argumentos que necesita este método.


 Sub MoverRangos3()
 Dim oHojaActiva As Object
 Dim oOrigen As Object
 Dim oDestino As Object
 
     oHojaActiva = ThisComponent.getCurrentController.getActiveSheet()
     oOrigen = oHojaActiva.getCellRangeByName( "C5" )
     oDestino = oHojaActiva.getCellRangeByName( "F15" )
 
     'Validamos que los rangos sean correctos
     If oOrigen.getImplementationName() = "ScCellRangeObj" And oDestino.getImplementationName() = "ScCellObj" Then
         oHojaActiva.moveRange( oDestino.getCellAddress(), oOrigen.getRangeAddress() )
     Else
         MsgBox "Los rangos no son correctos"
     End If
 
 End Sub


Esta validación es más útil cuando tomamos el rango a mover a partir de la selección actual del usuario, para que funcione el siguiente código, tienes que seleccionar más de una celda es decir, un rango de celdas, por supuesto, te queda de tarea hacer que funcione, aun y con solo seleccionar una celda.


 Sub MoverRangos4()
 Dim oHojaActiva As Object
 Dim oOrigen As Object
 Dim oDestino As Object
 
     oHojaActiva = ThisComponent.getCurrentController.getActiveSheet()
     oOrigen = ThisComponent.getCurrentSelection()
     'Validamos que los rangos sean correctos
     If oOrigen.getImplementationName() = "ScCellRangeObj" Then
         'Dejamos una columna y una fila en blanco
         oDestino = oHojaActiva.getCellByPosition( oOrigen.getRangeAddress.EndColumn + 2, oOrigen.getRangeAddress.EndRow + 2 )
         oHojaActiva.moveRange( oDestino.getCellAddress, oOrigen.getRangeAddress() )
     Else
         MsgBox "El rango Origen no es correcto"
     End If
 
 End Sub


Nota como solo validamos el origen, por que el destino lo construimos a partir del este, observa que cuando mueves un rango, la selección actual no cambia, se queda en el rango origen, si seleccionamos el rango cuando se ha movido, podremos ir moviendo el rango, tantas veces como llames a la macro, modifica la macro anterior para que quede así.


 Sub MoverRangos5()
 Dim oHojaActiva As Object
 Dim oOrigen As Object
 Dim oDestino As Object
 
     oHojaActiva = ThisComponent.getCurrentController().getActiveSheet()
     oOrigen = ThisComponent.getCurrentSelection()
     If oOrigen.getImplementationName() = "ScCellRangeObj" Then
         oDestino = oHojaActiva.getCellByPosition( oOrigen.getRangeAddress().EndColumn + 2, oOrigen.getRangeAddress().EndRow + 2 )
         oHojaActiva.moveRange( oDestino.getCellAddress(), oOrigen.getRangeAddress() )
         'Seleccionamos el nuevo origen
         ThisComponent.getCurrentController.select( oOrigen )
     Else
         MsgBox "El rango Origen no es correcto"
     End If
 
 End Sub


Y llámala (ejecútala) varias veces, notaras como se va moviendo el rango, pero cuidado, puede pasar que en algún momento te un error, ¿cuando?, muy bien, cuando el rango destino quede fuera de la hoja de calculo, por lo que tenemos que evaluar también que esto no suceda.


 Sub MoverRangos6()
 Dim oHojaActiva As Object
 Dim oOrigen As Object
 Dim oDestino As Object
 Dim lLimiteCol As Long
 
     oHojaActiva = ThisComponent.getCurrentController.getActiveSheet()
     oOrigen = ThisComponent.getCurrentSelection()
     If oOrigen.getImplementationName() = "ScCellRangeObj" Then
         'Garantizamos que no sobre pase el máximo de columnas en la hoja de calculo
         lLimiteCol = oOrigen.getRangeAddress.EndColumn + 2 + oOrigen.getColumns.getCount()
         If lLimiteCol <= oHojaActiva.getColumns.getCount() Then
             oDestino = oHojaActiva.getCellByPosition( oOrigen.getRangeAddress.EndColumn + 2, oOrigen.getRangeAddress.EndRow + 2 )
             oHojaActiva.moveRange( oDestino.getCellAddress, oOrigen.getRangeAddress() )
             ThisComponent.getCurrentController.select( oOrigen )
         Else
             MsgBox "Se llegó al limite de la hoja"
         End If
     Else
         MsgBox "Los rangos no son correctos"
     End If
 
 End Sub


Nota que con oHojaActiva.getColumns().getCount(), obtenemos el total de columnas de la hoja activa, no importa si esta tiene 256 como en OpenOffice.org 2.x o 1.024 como en OpenOffice.org 3.x o las que lleguen a tener más delante, con lo que este código funcionara en las dos versiones, de hecho, en cualquier versión que implemente estas propiedades, y si, claro que tienes que evaluar también que no pases el limite de filas, pero esa, es tu tarea.


Hasta ahora hemos movido rangos dentro de la misma hoja, pero de forma muy sencilla podemos mover rangos entre hojas, solo hay que establecer el destino correctamente y el método se encargará del resto.


 Sub MoverRangos7()
 Dim oHojaActiva As Object
 Dim oOrigen As Object
 Dim oDestino As Object
 Dim lLimiteCol As Long
 
     oHojaActiva = ThisComponent.getCurrentController.getActiveSheet()
     oOrigen = ThisComponent.getCurrentSelection()
     If oOrigen.getImplementationName() = "ScCellRangeObj" Then
         oDestino = ThisComponent.getSheets.getByIndex(0).getCellByPosition( 0, 0 )
         oHojaActiva.moveRange( oDestino.getCellAddress(), oOrigen.getRangeAddress() )
         ThisComponent.getCurrentController.select( oOrigen )
     Else
         MsgBox "El rango Origen no es correcto"
     End If
 
 End Sub


Observa como el origen lo establecemos en la hoja activa, pero el destino lo referenciamos a la primer hoja del documento, claro que puedes hacerlo a cualquier otra, por índice o por nombre como ya lo hemos aprendido. Nota que el método moveRange, lo llamamos desde la hoja activa, pero también lo puedes llamar desde cualquier hoja, lo importante es que los argumentos, es decir, el origen y destino estén correctos, observa en el siguiente ejemplo, como llamamos al método moveRange desde la hoja del rango destino.


 Sub MoverRangos8()
 Dim oHojaActiva As Object
 Dim oOrigen As Object
 Dim oDestino As Object
 Dim lLimiteCol As Long
 
     oHojaActiva = ThisComponent.getCurrentController.getActiveSheet()
     oOrigen = ThisComponent.getCurrentSelection()
     If oOrigen.getImplementationName() = "ScCellRangeObj" Then
         oDestino = ThisComponent.getSheets.getByIndex(0).getCellByPosition( 0, 0 )
         oDestino.getSpreadSheet.moveRange( oDestino.getCellAddress(), oOrigen.getRangeAddress() )
         ThisComponent.getCurrentController.select( oOrigen )
     Else
         MsgBox "El rango Origen no es correcto"
     End If
 
 End Sub


También podemos mover una columna completa, recuerda que una columna no es más que un rango de celdas.


 Sub MoverRangos9()
 Dim oHojaActiva As Object
 Dim oOrigen As Object
 Dim oDestino As Object
 
     oHojaActiva = ThisComponent.getCurrentController.getActiveSheet()
     'Referenciamos como origen la columna E
     oOrigen = oHojaActiva.getColumns.getByIndex(4)
     'Como destino una columna a la derecha
     oDestino = oHojaActiva.getCellByPosition( oOrigen.getRangeAddress().EndColumn + 1, 0 ) 
     oHojaActiva.moveRange( oDestino.getCellAddress(), oOrigen.getRangeAddress() )
     ThisComponent.getCurrentController.select( oOrigen )
 
 End Sub


Y ya encarrerados, movemos filas también.


 Sub MoverRangos10()
 Dim oHojaActiva As Object
 Dim oOrigen As Object
 Dim oDestino As Object
 
     oHojaActiva = ThisComponent.getCurrentController.getActiveSheet()
     'Referenciamos como origen la fila 5
     oOrigen = oHojaActiva.getRows.getByIndex(4)
     'Como destino la fila 10
     oDestino = oHojaActiva.getCellByPosition( 0, 9 )
     oHojaActiva.moveRange( oDestino.getCellAddress(), oOrigen.getRangeAddress() )
     ThisComponent.getCurrentController.select( oOrigen )
 
 End Sub


Cuando muevas columnas y filas completas, ten en cuenta las mismas consideraciones vistas en los demás ejemplos, de las cuales las principales son que los datos se mueven del origen al destino sin preguntar, es decir, no hay ninguna confirmación de sobre-escritura en caso de que el destino no este vacío, por lo que tú tienes que implementar esta validación y tener cuidado de no salirse de los limites de la hoja de calculo.


Insertando rangos

En la interfaz del usuario, cuando insertamos un rango, recordaras que Calc, nos muestra un cuadro de dialogo preguntándonos como desplazar las celdas adyacentes, esta misma consideración hay que tener cuando lo hacemos por código, veamos como.


Hoja.insertCells( Celdas As CellRangeAddress, Modo As CellInsertMode)


 Sub InsertarRangos1()
 Dim oHojaActiva As Object
 Dim oSel As Object
 
     oHojaActiva = ThisComponent.getCurrentController.getActiveSheet()
     oSel = ThisComponent.getCurrentSelection()
 
     'Insertamos un rango de celdas igual a la selección actual
     'y movemos las celdas hacia abajo
     oHojaActiva.insertCells(oSel.getRangeAddress(), com.sun.star.sheet.CellInsertMode.DOWN)
 
 End Sub


El rango a insertar no tiene por que ser a partir de la selección actual, puedes crear una estructura CellRangeAddress vacía del tamaño que quieras como en el siguiente ejemplo.


 Sub InsertarRangos2()
 Dim oHojaActiva As Object
 Dim oRango As Object
 
     oHojaActiva = ThisComponent.getCurrentController.getActiveSheet()
 
     'Creamos una estructura vacía de dirección de un rango
     oRango = CreateUnoStruct( "com.sun.star.table.CellRangeAddress" )
 
     'Establecemos los valores del rango, tres filas por tres columnas
     With oRango
         .Sheet = oHojaActiva.getRangeAddress().Sheet
         .StartColumn = 1
         .StartRow = 1
         .EndColumn = 3
         .EndRow = 3
     End With
 
     'Insertamos y desplazamos hacia la derecha
     oHojaActiva.insertCells(oRango, com.sun.star.sheet.CellInsertMode.RIGHT)
 
 End Sub


Es muy importante que establezcas la propiedad Sheet (hoja) de esta estructura, si no lo haces, el valor predeterminado es 0, con lo que el rango insertado “siempre” lo hará en la primer hoja del documento. En este segundo ejemplo hemos desplazado las celdas a la derecha, las demás opciones de este método son insertar filas completas o columnas completas, en la siguiente tabla resumimos los cuatro valores posibles para este método.


Constante Valor
com.sun.star.sheet.CellInsertMode.DOWN 1
com.sun.star.sheet.CellInsertMode.RIGHT 2
com.sun.star.sheet.CellInsertMode.ROWS 3
com.sun.star.sheet.CellInsertMode.COLUMNS 4


Puedes usar indistintamente la constante o el valor de esta como en el siguiente ejemplo donde insertamos filas completas.


 Sub InsertarRangos3()
 Dim oHojaActiva As Object
 Dim oRango As Object
 
     oHojaActiva = ThisComponent.getCurrentController.getActiveSheet()
     oRango = CreateUnoStruct( "com.sun.star.table.CellRangeAddress" )
 
     With oRango
         .Sheet = oHojaActiva.getRangeAddress().Sheet
         .StartColumn = 1
         .StartRow = 1
         .EndColumn = 3
         .EndRow = 3
     End With
 
     'Insertamos filas completas
     oHojaActiva.insertCells( oRango, 3 )
 
 End Sub


Cuando quieras insertar filas o columnas completas, puedes usar los métodos vistos hasta ahora o, puedes usar los métodos específicos del conjunto de filas y columnas como en el siguiente ejemplo donde insertamos 2 columnas a partir de la columna E.


 Sub InsertarRangos4()
 Dim oHojaActiva As Object
 
     oHojaActiva = ThisComponent.getCurrentController.getActiveSheet()
 
     'Insertamos 2 columnas a partir de la columna E
     oHojaActiva.getColumns.insertByIndex( 4, 2 )
 
 End Sub


Nota que ahora usamos el método insertByIndex, que es especifico del conjunto de columnas, por ello primero llamados a getColumns(), el primer argumento de este método es el índice de la columna donde comenzara la inserción y el segundo es el número de columnas que deseamos insertar. El método para insertar filas es exactamente igual, excepto por que lo llamamos desde el conjunto de filas (getRows) como en.


 Sub InsertarRangos5()
 Dim oHojaActiva As Object
 
     oHojaActiva = ThisComponent.getCurrentController.getActiveSheet()
 
     'Insertamos 5 filas a partir de la fila 3
     oHojaActiva.getRows.insertByIndex( 2, 5 )
 
 End Sub


Para terminar este tema, recuerda que no puedes desplazar celdas fuera del rango de la hoja de calculo, por lo que tienes que evaluar que tengas suficiente espacio para la inserción, de lo contrario, te dará un error en tiempo de ejecución.


Eliminando rangos

Eliminar rangos, es la operación inversa a insertarlos, en este caso, tenemos que decidir que hacer con las celdas adyacentes al rango, es decir, como se desplazarán, en nuestro primer ejemplo, movemos las celdas hacia arriba.


Hoja.removeRange( Celdas As CellRangeAddress, Modo As CellDeleteMode)


 Sub BorrarRangos1()
 Dim oHojaActiva As Object
 Dim oSel As Object
 
     oHojaActiva = ThisComponent.getCurrentController.getActiveSheet()
     oSel = ThisComponent.getCurrentSelection()
 
     'Borramos la selección actual y movemos las celdas hacia arriba
     oHojaActiva.removeRange( oSel.getRangeAddress(), com.sun.star.sheet.CellDeleteMode.UP )
 
 End Sub


Cuando se hace cualquier operación de borrado o eliminación, es una buena practica de programación que confirmes esta acción con el usuario, sobre todo, con aquellas acciones que no es posible deshacer, es casi una regla que lo hagas. En el siguiente ejemplo, desplazamos hacia la izquierda, después de confirmar la eliminación.


 Sub BorrarRangos2()
 Dim oHojaActiva As Object
 Dim oRango As Object
 Dim iRes As Integer
 
     oHojaActiva = ThisComponent.getCurrentController().getActiveSheet()
     oRango = CreateUnoStruct( "com.sun.star.table.CellRangeAddress" )
 
     'Establecemos el rango E8:F21
     oRango = oHojaActiva.getCellRangeByName( "E8:F21" )
 
     'Confirmamos la eliminacion
     iRes = MsgBox( "Estas seguro de borrar el rango", 4 + 32, "Borrar rango" )
 
     'Solo borramos si el usuario respondió SI
     If iRes = 6 Then
         'Borramos el rango y movemos las celdas hacia la izquierda
         oHojaActiva.removeRange( oRango.getRangeAddress, com.sun.star.sheet.CellDeleteMode.LEFT )
     End If
 
 End Sub


En la siguiente tabla puedes ver las posibilidades de este método, así como sus valores que puedes usar en vez de ellas.


Constante Valor
com.sun.star.sheet.CellDeleteMode.UP 1
com.sun.star.sheet.CellDeleteMode.LEFT 2
com.sun.star.sheet.CellDeleteMode.ROWS 3
com.sun.star.sheet.CellDeleteMode.COLUMNS 4


Podemos borrar columnas completas, en el siguiente ejemplo usamos el valor de la constante en vez de esta, ya no pedimos confirmación, pero te recomiendo siempre hacerla.


 Sub BorrarRangos3()
 Dim oHojaActiva As Object
 Dim oRango As Object
 Dim iRes As Integer
 
     oHojaActiva = ThisComponent.getCurrentController().getActiveSheet()
     oRango = CreateUnoStruct( "com.sun.star.table.CellRangeAddress" )
 
     'Establecemos el rango B2:D2
     oRango = oHojaActiva.getCellRangeByName( "B2:D2" )
 
     'Borramos las columnas completas
     oHojaActiva.removeRange( oRango.getRangeAddress, 4 )
 
 End Sub


Al igual que con la inserción, para la eliminación de filas y columnas completas, se cuenta con métodos alternativos accesibles desde el conjunto de filas (getRows) y columnas (getColumns), veamos como.


 Sub BorrarRangos4()
 Dim oHojaActiva As Object
 
     oHojaActiva = ThisComponent.getCurrentController().getActiveSheet()
 
     'Borramos 3 filas a partir de la fila 10
     oHojaActiva.getRows.removeByIndex( 9, 3 )
 
     'Borramos 2 columnas a partir de la A
     oHojaActiva.getColumns.removeByIndex( 0, 2 )
 
 End Sub


No se te olvide siempre confirmar las eliminaciones.


Copiando rangos

Copiar rangos es muy similar a moverlos, se usan los mismos argumentos, un rango origen y una celda destino, claro, cambia el método usado, al igual que cuando movemos, el destino será reemplazado con el origen sin ningún tipo de confirmación, pero como ya sabes implementarla, no tienes problemas con ello, ¿verdad?


Hoja.copyRange( Destino As CellAddress, Origen As CellRangeAddress)


 Sub CopiarRangos1()
 Dim oHojaActiva As Object
 Dim oOrigen As Object
 Dim oDestino As Object
 
     oHojaActiva = ThisComponent.getCurrentController().getActiveSheet()
     'Rango a copiar
     oOrigen = oHojaActiva.getCellRangeByName( "A1:B3" )
     'Celda destino
     oDestino = oHojaActiva.getCellRangeByName( "D10" )
 
     'Copiamos el rango
     oHojaActiva.copyRange( oDestino.getCellAddress(), oOrigen.getRangeAddress() )
 
 End Sub


A diferencia de cuando movemos, el origen permanece tal cual y aquí si, si el rango contiene formulas, las referencias relativas se ajustarán automáticamente a la nueva posición, además de que el rango origen permanece con la referencia original.


 Sub CopiarRangos2()
 Dim oHojaActiva As Object
 Dim oOrigen As Object
 Dim oDestino As Object
 
     oHojaActiva = ThisComponent.getCurrentController.getActiveSheet()
     oOrigen = ThisComponent.getCurrentSelection()
 
     oDestino = oHojaActiva.getCellByPosition( oOrigen.getRangeAddress.EndColumn + 1, oOrigen.getRangeAddress.EndRow + 1 )
     oHojaActiva.copyRange( oDestino.getCellAddress, oOrigen.getRangeAddress() )
 
     ThisComponent.getCurrentController.select( oOrigen )
 
 End Sub


Para copiar en una hoja diferente, solo tienes que establecer el destino correctamente en dicha hoja, el siguiente ejemplo, copiamos el rango B2:D5 de la ultima hoja del documento a la celda A1 de la primera.


 Sub CopiarRangos3()
 Dim oHojaOrigen As Object
 Dim oHojaDestino As Object
 Dim oOrigen As Object
 Dim oDestino As Object
 
     oHojaOrigen = ThisComponent.getSheets.getByIndex( ThisComponent.getSheets.getCount() - 1 )
     oHojaDestino = ThisComponent.getSheets.getByIndex( 0 )
 
     'Rango a copiar
     oOrigen = oHojaOrigen.getCellRangeByName( "B2:D5" )
     'Celda destino
     oDestino = oHojaDestino.getCellRangeByName( "A1" )
 
     'Copiamos el rango
     oHojaDestino.copyRange( oDestino.getCellAddress(), oOrigen.getRangeAddress() )
 
     ThisComponent.getCurrentController.select( oDestino )
 
 End Sub


Puedes copiar columnas o filas completas.


 Sub CopiarRangos4()
 Dim oHojaOrigen As Object
 Dim oHojaDestino As Object
 Dim oOrigen As Object
 Dim oDestino As Object
 
     'Primer hoja 
     oHojaOrigen = ThisComponent.getSheets.getByIndex( 0 )
     'Rango a copiar columna B
     oOrigen = oHojaOrigen.getColumns.getByIndex( 1 )
     'Segunda Hoja 
     oHojaDestino = ThisComponent.getSheets.getByIndex( 1 )
     oDestino = oHojaDestino.getCellRangeByName( "E1" )
 
     oHojaDestino.copyRange( oDestino.getCellAddress(), oOrigen.getRangeAddress() )
 
     ThisComponent.getCurrentController.select( oDestino )
 
 End Sub


Hagamos algo muy interesante, como sabemos, cuando copiamos un rango de celdas y este rango tiene filas o columnas ocultas manualmente o por estar agrupadas, la copia resultante, contendrá aun, las filas y columnas ocultas, con el método para seleccionar solo las celdas visibles (queryVisibleCells) aprendido en el capitulo anterior y el método para copiar rangos, podemos intentar hacer nuestra versión de una herramienta que llamaremos Copiar solo visibles, ¿te parece? Antes de que sigas leyendo, te invito a que intentes resolverlo por ti mismo primero, después checa mi versión y compáralas, claro, solo con fines didácticos puesto que estamos aprendiendo.


 Sub CopiarSoloVisibles1()
 Dim oSel As Object
 Dim oCursor As Object
 Dim oVisibles As Object
 Dim oHojaOrigen As Object
 Dim oHojaDestino As Object
 Dim oRangoOrigen As Object
 Dim oCeldaDestino As New com.sun.star.table.CellAddress
 Dim co1 As Long
 Dim mDir
 
     oHojaOrigen = ThisComponent.getCurrentController.getActiveSheet()
     'Referencia a la selección actual
     oSel = ThisComponent.getcurrentSelection()
     'Si es una sola celda regresamos la región actual
     If oSel.getImplementationName() = "ScCellObj" Then
         oCursor = oSel.getSpreadSheet.createCursorByRange( oSel )
         oCursor.collapseToCurrentRegion()
         'Y las celdas visibles
         oVisibles = oCursor.queryVisibleCells()
     ElseIf oSel.getImplementationName() = "ScCellRangesObj" Then
         oVisibles = oSel
     End If    
 
     'si no hay celdas visibles
     If IsNull( oVisibles ) Then
         MsgBox "No hay celdas ocultas"
     Else
         'Agregamos una nueva hoja
         oHojaDestino = getNuevaHoja( ThisComponent, oHojaOrigen )
         'Obtenemos una matriz con las direcciones de todos los rangos
         mDir = oVisibles.getRangeAddresses()
         'Iteramos en cada dirección
         For co1 = LBound(mDir) To UBound(mDir)
             oRangoOrigen = mDir( co1 )
             'La celda destino tendrá la misma dirección del rango pero en la hoja destino
             oCeldaDestino.Sheet = oHojaDestino.getRangeAddress.Sheet
             oCeldaDestino.Column = oRangoOrigen.StartColumn
             oCeldaDestino.Row = oRangoOrigen.StartRow
             'Copiamos el rango
             oHojaDestino.copyRange( oCeldaDestino, oRangoOrigen )
         Next co1
         'Seleccionamos la nueva hoja con los datos copiados
         ThisComponent.getCurrentController.setActiveSheet( oHojaDestino )
         MsgBox "Rangos copiados"
     End If
 
 End Sub
 
 'Devuelve una nueva hoja en Documento, a la derecha del argumento Hoja
 Function getNuevaHoja( Documento As Object, Hoja As Object ) As Object
 Dim oHojas As Object
 Dim co1 As Integer
 Dim sNombre As String
 
     oHojas = Documento.getSheets()
     sNombre = "Rangos Copiados"
     Do While oHojas.hasByName( sNombre )
         co1 = co1 + 1
         sNombre = sNombre & " " & Format(co1)
     Loop
     oHojas.insertNewByName( sNombre, Hoja.getRangeAddress.Sheet+1 )
     getNuevaHoja = Documento.getSheets.getByName( sNombre )
 
 End Function


Seguro que ya viste que no trabaja muy bien que digamos, claro, no es nada practico que use la misma dirección del origen en el destino pues los datos quedan todos dispersos. Vamos a mejorarla, de nuevo, intenta corregirla tu y después continuas.


 Sub CopiarSoloVisibles2()
 Dim oSel As Object
 Dim oCursor As Object
 Dim oVisibles As Object
 Dim oHojaOrigen As Object
 Dim oHojaDestino As Object
 Dim oRangoOrigen As Object
 Dim oRangoAnterior As Object
 Dim oCeldaDestino As New com.sun.star.table.CellAddress
 Dim co1 As Long, Fil As Long, Col As Long
 Dim mDir
 
     oHojaOrigen = ThisComponent.getCurrentController.getActiveSheet()
     oSel = ThisComponent.getcurrentSelection()
     Select Case oSel.getImplementationName
         Case "ScCellObj"
             oCursor = oSel.getSpreadSheet.createCursorByRange( oSel )
             oCursor.collapseToCurrentRegion()
             oVisibles = oCursor.queryVisibleCells()
         Case "ScCellRangeObj", "ScCellRangesObj" 
             oVisibles = oSel.queryVisibleCells()
     End Select
 
     If IsNull( oVisibles ) Then
         MsgBox "No hay celdas ocultas o no es un rango de celdas"
     Else
         Fil = 0
         Col = 0
         oHojaDestino = getNuevaHoja( ThisComponent, oHojaOrigen )
         mDir = oVisibles.getRangeAddresses()
         'Copiamos el primer rango
         oRangoOrigen = mDir( 0 )
         oCeldaDestino.Sheet = oHojaDestino.getRangeAddress.Sheet
         'En la celda A1
         oCeldaDestino.Column = 0
         oCeldaDestino.Row = 0
         oHojaDestino.copyRange( oCeldaDestino, oRangoOrigen )
         'Si tenemos más rangos
         If oVisibles.getCount() > 1 then
             For co1 = 1 To UBound(mDir)
                 oRangoOrigen = mDir( co1 )
                 oRangoAnterior = mDir( co1-1 )
                 'Vamos sumando cada ancho y alto de cada rango, solo cuando cambien
                 If oRangoAnterior.StartColumn = oRangoOrigen.StartColumn Then
                     oCeldaDestino.Row = oCeldaDestino.Row + oRangoAnterior.EndRow - oRangoAnterior.StartRow + 1
                 Else
                     oCeldaDestino.Column = Col + oRangoAnterior.EndColumn - oRangoAnterior.StartColumn + 1
                     oCeldaDestino.Row = Fil
                     Col = oCeldaDestino.Column
                 End If
                 oHojaDestino.copyRange( oCeldaDestino, oRangoOrigen )
             Next co1
         End If
         ThisComponent.getCurrentController.setActiveSheet( oHojaDestino )
     End If    
 
 End Sub


Ahora si, trabaja mucho mejor, pero, todavía tiene un pequeño detalle, hay un caso particular donde el rango no contenga celdas ocultas y nuestra macro no lo informe, y digo que es un detalle por que no te dará ningún error y seguirá funcionando, puedes considerar evaluarlo o dejarla así, pero eso si, tu tarea es encontrar este caso particular. También, podrías mejorar esta macro para que copie solo datos o resultados de formulas, esto lo podrás hacer cuando adquieras los conocimientos del próximo capitulo.



ES.Plantillas.Logo foro es.png
Si tienes dudas acerca de lo aquí explicado, tienes algún problema con AOO,
o quieres ampliar la información, no dudes en dirigirte al

Foro Oficial en español de Apache OpenOffice para Macros y API UNO

Personal tools