Mientras llegan los más expertos, unas macros (huelga decir que mejorables) basadas en la de Mauricio que
- Si le pasamos un rango de celdas resaltará fila/columna solo en ese área
- Si no se le pasa, ninguno asume el área con datos
- cuando se selecciona celda fuera del área quita el resalte.
En mis pruebas es funcional aunque además de pulir el código, echo en falta
-
enviar el dibujo-formas al fondo de la hoja Mauricio dió la solución
- poder llamarlos por su nombre en vez de por su índice.
Código: Seleccionar todo
Sub Resalta
'Asignar una macro al evento «Al cambiar selección» de la hoja llamando a la subrutina/función ResaltarXY
ResaltarXY("RangoT") '→ Un rango con nombre
' ResaltarXY("C7:N77") '→ dirección de rango de celdas
' ResaltarXY("") '→ Cadena vacía → hasta última celda con datos
' ResaltarXY() '→ ausente → hasta última celda con datos
End Sub
'______________________________________________________________
Sub ResaltarXY(Optional nRango)
'Parámetros: nombre de un rango "MiNombreDeRango" o "A1:AA50000" o "Hoja.A1:$G$55"
'Resalta fila y columna en el rango, cuando se selecciona una de sus celdas
'Requisitos: han de crearse dos rectángulos en la hoja del rango
'si no se le pasa como nombre de rango/"" asume el área con datos de la hoja
'Poner en «Mis Macros» para que pueda ser llamada desde cualquier hoja
On Error GoTo Salir
Dim oDoc As Object
Dim oControlador As Object
Dim oCursor As Object
Dim oSel As Object
Dim oDP As Object
Dim shape1 As Object
Dim shape2 As Object
Dim pos
Dim size
Dim Ancho
Dim Alto
Dim RResalt
Dim FilaSel
Dim ColSel
Dim oDib As Object
Dim i As Integer
Dim ETQ As String
ETQ= "BarraResaltar"
oDoc = ThisComponent
oControlador = oDoc.CurrentController
oSel = oControlador.Selection
If Not (oSel.ImplementationName = "ScCellObj") Then 'Si la seleccion no es una celda nos vamos
GoTo Fin
End If
oDP = oSel.getSpreadSheet().getDrawPage()
'si la celda seleccionada no está en rango → quitar dibujos del resalte solamente y salir
ColSel = oSel.getRangeAddress.StartColumn
FilaSel = oSel.getRangeAddress.StartRow
If IsMissing(nRango) or nRango="" Then
oCursor = oSel.getSpreadSheet.createCursorByRange(oSel)
oCursor.gotoEndOfUsedArea( False )
nRango= Replace(oCursor.AbsoluteName, ".", ".A1:")
End If
RResalt = oControlador.ActiveSheet.getCellRangeByName(nRango)
If ColSel > RResalt.getRangeAddress.EndColumn Or ColSel < RResalt.getRangeAddress.StartColumn Or _
FilaSel > RResalt.getRangeAddress.EndRow Or FilaSel < RResalt.getRangeAddress.StartRow Then
For i= (oDP.getCount - 1) To 0 Step -1
oDib = oDP.getByIndex(i)
If oDib.Name = ETQ & "Columna" Or oDib.Name = ETQ & "Fila" Then
oDP.Remove(oDib)
End If
Next
GoTo Fin
Else
'Estamos en el área → crear dibujos si no están creados
Dim index1, index2 As Integer
For i=0 To oDP.getCount - 1
oDib = oDP.getByIndex(i)
If oDib.Name = ETQ & "Columna" Then
index1 = i
ElseIf oDib.Name = ETQ & "Fila" Then
index2 = i
End If
Next
If index2 <1 Then
DibForma(5000, 300, ETQ & "Columna")
DibForma(500, 3000, ETQ & "Fila")
End If
End If
oCursor = RResalt.getSpreadSheet.createCursorByRange(RResalt)
Ancho = oCursor.Size.Width
Alto = oCursor.Size.Height
oCursor.gotoEndOfUsedArea( False )
shape1 = oDP.getByIndex(oDP.getCount - 1) ' esto supone que no se deben crear dibujos ...
shape2 = oDP.getByIndex(oDP.getCount - 2) ' ... con celda seleccionada en area de resaltado
pos = oSel.Position
size = oSel.Size
size.Width = Ancho
pos.X = RResalt.Position.X
shape1.setPosition(pos)
shape1.setSize(size)
pos = oSel.Position
size = oSel.Size
size.Height = Alto
pos.Y = RResalt.Position.Y
shape2.setPosition(pos)
shape2.setSize(size)
Fin:
Exit Sub
Salir:
MsgBox " Ummmm ... error!" & Chr(13) & "¿Es correcto el nombre del rango?",, "Aviso"
End Sub
'--------------------------------------------------------------------------------
Sub DibForma(Ancho As Long, Alto As Long, nDib As String, Optional TipoForma As String)
'Crea un dibujo en la hoja activa desde la que es llamada
'Poner en «Mis macros» para que sea accesible siempre.
Dim oPaginaDibujo As Object
Dim oForma As Object
Dim oTam As New com.sun.star.awt.Size
oPaginaDibujo = ThisComponent.getCurrentController.getActiveSheet.getDrawPage()
If IsMissing(TipoForma) Then TipoForma = "RectangleShape"
oForma = ThisComponent.createInstance("com.sun.star.drawing." & TipoForma) 'RectangleShape")
oTam.Width= Ancho
oTam.Height= Alto
With oForma
.LineStyle = com.sun.star.drawing.LineStyle.NONE
.FillColor = RGB( 75,75,75 )
.FillTransparence = 85
.setSize (oTam)
.LayerID = 1
.Name = nDib
End With
oPaginaDibujo.Add( oForma )
End Sub
)
)