[RESUELTO] Macro para copiar solo celdas visibles
Publicado: Sab Ago 08, 2009 5:47 am
Hola a todos:
En el foro de Calc, hay un hilo http://user.services.openoffice.org/es/ ... =21&t=1292 donde se discute la posibilidad de seleccionar celdas visibles, por supuesto con OOo Basic es posible de una forma sencilla, se complica un poco al querer copiar pero sigue siendo posible. Cuando haces uso de filtros o subtotales, e intentas copiar, Calc te copia efectivamente las celdas visibles, pero intenta hacer un filtro y después oculta una columna manualmente, veras que el copiado ya no es correcto, de hecho, siempre que ocultas filas o columnas manualmente, Calc no te permite copiar, aquí es donde entra OOo Basic.
Solicito a todos los compañeros interesados, copiar y probar la siguiente macro, por favor, oculten filas y columnas y hagan varias pruebas para verificar su funcionamiento, por favor, si ven algún error y se les ocurre alguna mejor, usen este hilo para que la terminemos entre todos.
Gracias y un abrazo a todos.
Mauricio
En el foro de Calc, hay un hilo http://user.services.openoffice.org/es/ ... =21&t=1292 donde se discute la posibilidad de seleccionar celdas visibles, por supuesto con OOo Basic es posible de una forma sencilla, se complica un poco al querer copiar pero sigue siendo posible. Cuando haces uso de filtros o subtotales, e intentas copiar, Calc te copia efectivamente las celdas visibles, pero intenta hacer un filtro y después oculta una columna manualmente, veras que el copiado ya no es correcto, de hecho, siempre que ocultas filas o columnas manualmente, Calc no te permite copiar, aquí es donde entra OOo Basic.
Solicito a todos los compañeros interesados, copiar y probar la siguiente macro, por favor, oculten filas y columnas y hagan varias pruebas para verificar su funcionamiento, por favor, si ven algún error y se les ocurre alguna mejor, usen este hilo para que la terminemos entre todos.
Gracias y un abrazo a todos.
Mauricio
Código: Seleccionar todo
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
'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