Manipulando rangos
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.
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 |