Estimados Amigos:
En el foro de OOo (al cual invito a subscribirse y colaborar), se inicio
un hilo acerca de seleccionar celdas visibles en Calc:
http://user.services.openoffice.org/es/forum/viewtopic.php?f=21&t=1292
Coincidentemente estaba complementando mis apuntes con este tema,
agradezco a quien pueda hacer algunas pruebas con la siguiente macro,
usen un listado en donde tengan filas y columnas ocultas manualmente,
que es, la situación donde Calc no permite hacer copias de solo las
celdas visibles.
Agradezco su tiempo y reciban un abrazo desde tierras mexicanas.
Saludos
Mauricio
P.D. A los interesados en la programación de macros con OOo Basic, en
estas listas, los invito a subscribirse también a la lista exclusiva de
este tema que he abierto y administro yo mismo
http://www.egrupos.net/grupo/ooobasic_es/alta
________________________________
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
--
__________________________________
Todo lo que no es dado es perdido
---------------------------------------------------------------------
To unsubscribe, e-mail: [email protected]
For additional commands, e-mail: [email protected]
