¡Hola gente!
Me gustaría resaltar solo la fila (no la columna) en el código del archivo adjunto:
Fuente: https://forum.openoffice.org/es/forum/v ... 166#p37741
¡Gracias por la atención!
Orlando Souza
[/color]
Resalta solo la fila de celdas seleccionada
Resalta solo la fila de celdas seleccionada
LibreOffice 6.4.1.2 (x86) Portable
Re: Resalta solo la fila de celdas seleccionada
La macro «ResaltarXY» crea dos dibujos "shapes". Para que sea uno... basta con "comentar" las líneas que se refieran a uno de ellos (ETQ&columna, ETQfila)
Sustitúyela por esta otra que ya está "comentada"
Sustitúyela por esta otra que ya está "comentada"
Código: Seleccionar todo
Sub ResaltarXY(Optional nRango, Optional Back As Integer)
'Parámetros: nombre de un rango "MiNombreDeRango" o "A1:AA50000" o "Hoja.A1:$G$55"
'Resalta fila y columna solo en el rango operativo si se se selecciona una de sus celdas
'Si no se le pasa un nombre de rango o este es ""
'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
'>>Back=2 → los resaltes se situan delante del fondo celdas y de las formas que no son ocultan anotaciones de celda
'>>Back=1 → absolutamente detras de todo, incluso de celdas coloreadas : si no lo están es la más conveniente ;)
'>>Back=0 → se situan delante del fondo de celda y detras de todas-todas las forma :) pero son seleccionables a golpe de raton. :(
'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"
If IsMissing(Back) Then Back = 2
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
For i= (oDP.getCount - 1) To 0 Step -1
oDib = oDP.getByIndex(i)
If oDib.Name = ETQ & "Columna" Or oDib.Name = ETQ & "Fila" Then
GoTo Seguir
End If
Next
Dim oForma As Object
Dim oTam As New com.sun.star.awt.Size
For i=0 To 1
oTam.Width= 5000 - (4700*i)
oTam.Height= 300 + (4700*i)
oForma = ThisComponent.createInstance("com.sun.star.drawing.RectangleShape")
With oForma
If i=1 Then
.Name = ETQ & "Fila"
' Else
' .Name = ETQ & "Columna"
End If
.setSize (oTam)
.MoveProtect = True
.LineStyle = com.sun.star.drawing.LineStyle.NONE
.FillColor = RGB( 75,75,75 ) '<<<<<<<<<< color <<<<<<<<<<
.FillTransparence = 85 '<<<<<<<<<< transparencia <<<
.LayerID = Back
.ZOrder = 0
End With
oDP.Add(oForma)
Next
End If
Seguir:
oCursor = RResalt.getSpreadSheet.createCursorByRange(RResalt)
Ancho = oCursor.Size.Width
Alto = oCursor.Size.Height
oCursor.gotoEndOfUsedArea(False)
Dim index1, index2 As Integer
For i=0 To oDP.getCount - 1
oDib = oDP.getByIndex(i)
If oDib.Name = ETQ & "Fila" Then
index1 = i
' ElseIf oDib.Name = ETQ & "Columna" Then
' index2 = i
End If
Next
shape1 = oDP.getByIndex(index1)
' shape2 = oDP.getByIndex(index2)
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
- Adjuntos
-
- ResaltadoDeFilaColumaPruebas.ods
- modificada a solo filas
- (49.36 KiB) Descargado 149 veces
Todo es mejorable, estamos dispuestos a mejorar. ¿Yo? ... poco a poco.
Nunca hay acritud en mis comentarios, si lo pareciera, seguro que me he expresado mal.
Nunca hay acritud en mis comentarios, si lo pareciera, seguro que me he expresado mal.
Re: Resalta solo la fila de celdas seleccionada
Gracias por la respuesta, xiseme!
Aparece un problema en la línea de rango A1:D1, después de abrir su archivo.
Circulado en el color azul de la imagen a continuación:
Ps: Estoy usando Win10 + LibO6.4.1.2 (x86) Portable
Aparece un problema en la línea de rango A1:D1, después de abrir su archivo.
Circulado en el color azul de la imagen a continuación:
Ps: Estoy usando Win10 + LibO6.4.1.2 (x86) Portable
LibreOffice 6.4.1.2 (x86) Portable
Re: Resalta solo la fila de celdas seleccionada
No tengo el tiempo para ver donde está el problema.... Asi que... Cambiemos de estrategia.
Juguemos con los colores y la transparencia (si hacemos transparente el dibujo de la columna... es lo mismo que si no estuviera)
Esta nueva versión debería permitir elegir color y transparencia por separado para fila/columna según los parámetros que se le pasen a la macro «ResaltadoXY(...opciones...)»
Juguemos con los colores y la transparencia (si hacemos transparente el dibujo de la columna... es lo mismo que si no estuviera)
Código: Seleccionar todo
Option Explicit
'-------------------------------------------------
Sub ResaltXY
' ResaltadoXY() 'resaltaría con valores por defecto
Dim TC, CC, TF, CF As Double
TC=70
CC=RGB(200,0,0)
TF=80
CF=RGB(0,200,0)
ResaltadoXY("",TC,CC,TF,CF)
End Sub
'-------------------------------------------------
Sub ResartaRango3
ResaltadoXY("Rango3",99) 'Dib.Columna imperceptible
End Sub
'-------------------------------------------------
Sub ResaltaRRango
ResaltadoXY("RRango")
End Sub
'==================== Subrutina llamada por las macros asignadas a evento hoja "al cambiar selección" =========================
Sub ResaltadoXY(Optional nRango, Optional TranspColum As Integer, Optional CorColum As Double, Optional TranspFila As Integer, Optional CorFila As Double, Optional Back As Integer)
'Parámetros: nombre de un rango "MiNombreDeRango" o "A1:AA50000" o "Hoja.A1:$G$55"
'Resalta fila y columna solo en el rango operativo si se selecciona una de sus celdas
'Si no se le pasa un nombre de rango o este es ""
'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
'>>Back=2 → los resaltes se situan delante del fondo celdas y de las formas que no son ocultan anotaciones de celda
'>>Back=1 → absolutamente detras de todo, incluso de celdas coloreadas : si no lo están es la más conveniente ;)
'>>Back=0 → se situan delante del fondo de celda y detras de todas-todas las forma :) pero son seleccionables a golpe de raton. :(
'TranspColum[Fila] y CorColum[Fila] → transparencia (0=opaco 100=invisible) y color para Columna y Fila
'Poner en «Mis Macros» para que pueda ser llamada desde cualquier hoja
On Error GoTo ErrEscape
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"
'Valores por defecto si no se indican otros
If IsMissing(Back) Then Back = 2
If IsMissing(TranspColum) Then TranspColum = 85
If IsMissing(CorColum) Then CorColum = RGB( 75,75,75 )
If IsMissing(TranspFila) Then TranspFila = 85
If IsMissing(CorFila) Then CorFila = RGB( 75,75,75 )
oDoc = ThisComponent
oControlador = oDoc.CurrentController
oSel = oControlador.Selection
If Not (oSel.ImplementationName = "ScCellObj") And Not (oSel.ImplementationName = "ScCellRangeObj") 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
For i= (oDP.getCount - 1) To 0 Step -1
oDib = oDP.getByIndex(i)
If oDib.Name = ETQ & "Columna" Or oDib.Name = ETQ & "Fila" Then
GoTo Seguir
End If
Next
Dim oForma As Object
Dim oTam As New com.sun.star.awt.Size
For i=0 To 1
oTam.Width= 5000 - (4700*i)
oTam.Height= 300 + (4700*i)
oForma = ThisComponent.createInstance("com.sun.star.drawing.RectangleShape")
With oForma
If i=1 Then
.Name = ETQ & "Fila"
.FillTransparence = TranspColum '<<<<<<<<<< transparencia <<<
.FillColor = CorColum '<<<<<<<<<< color <<<<<<<<<<
Else
.Name = ETQ & "Columna"
.FillTransparence = TranspFila '<<<<<<<<<< transparencia <<<
.FillColor = CorFila '<<<<<<<<<< color <<<<<<<<<<
End If
.setSize (oTam)
.MoveProtect = True
.LineStyle = com.sun.star.drawing.LineStyle.NONE
.LayerID = Back
.ZOrder = 0
End With
oDP.Add(oForma)
Next
End If
Seguir:
oCursor = RResalt.getSpreadSheet.createCursorByRange(RResalt)
Ancho = oCursor.Size.Width
Alto = oCursor.Size.Height
oCursor.gotoEndOfUsedArea(False)
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
shape1 = oDP.getByIndex(index1)
shape2 = oDP.getByIndex(index2)
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
ErrEscape:
Select Case Err
Case 0
Case 1
MsgBox " Ummmm ... error!" & Chr(13) & Chr(13) & "¿Es correcto el nombre del rango" & nRango & "?", 48, "Aviso"
Case Else
MsgBox "Ocurrió el error numero: " & Err & Chr(13) & Error & _
Chr(13) & "Linea " & Erl
End Select
On Error Goto 0
End Sub
Todo es mejorable, estamos dispuestos a mejorar. ¿Yo? ... poco a poco.
Nunca hay acritud en mis comentarios, si lo pareciera, seguro que me he expresado mal.
Nunca hay acritud en mis comentarios, si lo pareciera, seguro que me he expresado mal.
Re: Resalta solo la fila de celdas seleccionada
El tema se resolvería si el archivo tuviera solo una Hoja2 y resaltara solo la fila (no la columna)
en la celda seleccionada, con la opción de elegir el color y la transparencia.
en la celda seleccionada, con la opción de elegir el color y la transparencia.
LibreOffice 6.4.1.2 (x86) Portable
Re: Resalta solo la fila de celdas seleccionada
Pues eso justamente es lo que ya está.
Es para ti la tarea de adaptar/ajustar a tus requisitos/gustos.
Fíjate en
TC= transparencia.columna CC= color.columna TF= transparencia.fila ....
Es para ti la tarea de adaptar/ajustar a tus requisitos/gustos.
Fíjate en
Código: Seleccionar todo
Sub ResaltXY
' ResaltadoXY() 'resaltaría con valores por defecto
Dim TC, CC, TF, CF As Double
TC=70
CC=RGB(200,0,0)
TF=80
CF=RGB(0,200,0)
ResaltadoXY("",TC,CC,TF,CF)
End Sub
Todo es mejorable, estamos dispuestos a mejorar. ¿Yo? ... poco a poco.
Nunca hay acritud en mis comentarios, si lo pareciera, seguro que me he expresado mal.
Nunca hay acritud en mis comentarios, si lo pareciera, seguro que me he expresado mal.