Resalta solo la fila de celdas seleccionada

Discute sobre la aplicación de hojas de cálculo

Resalta solo la fila de celdas seleccionada

Notapor OrlandoS » Vie Jul 17, 2020 2:21 am

¡Hola gente!

Me gustaría resaltar solo la fila (no la columna) en el código del archivo adjunto:
ResaltadoDeFilaColumaPruebas.ods
(49.76 KiB) 28 veces

Fuente: viewtopic.php?f=36&t=9166#p37741

¡Gracias por la atención!
Orlando Souza

:geek:
LibreOffice 6.4.1.2 (x86) Portable
Avatar de Usuario
OrlandoS
 
Mensajes: 3
Registrado: Mié Jul 15, 2020 1:08 am

Re: Resalta solo la fila de celdas seleccionada

Notapor xiseme » Sab Jul 25, 2020 6:21 pm

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"
Código: Seleccionar todo   Expandir vistaContraer vista
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) 26 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.
xiseme
 
Mensajes: 1908
Registrado: Lun Nov 24, 2008 1:13 pm

Re: Resalta solo la fila de celdas seleccionada

Notapor OrlandoS » Dom Jul 26, 2020 2:18 am

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:

imagen del problema.jpg
imagen del problema.jpg (57 KiB) Visto 297 veces

Ps: Estoy usando Win10 + LibO6.4.1.2 (x86) Portable
LibreOffice 6.4.1.2 (x86) Portable
Avatar de Usuario
OrlandoS
 
Mensajes: 3
Registrado: Mié Jul 15, 2020 1:08 am

Re: Resalta solo la fila de celdas seleccionada

Notapor xiseme » Dom Ago 02, 2020 11:44 pm

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)
Código: Seleccionar todo   Expandir vistaContraer vista
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 


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...)»
ResaltaResaltarXY.ods
(1.24 MiB) 26 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.
xiseme
 
Mensajes: 1908
Registrado: Lun Nov 24, 2008 1:13 pm

Re: Resalta solo la fila de celdas seleccionada

Notapor OrlandoS » Lun Ago 03, 2020 4:22 pm

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.
:(
LibreOffice 6.4.1.2 (x86) Portable
Avatar de Usuario
OrlandoS
 
Mensajes: 3
Registrado: Mié Jul 15, 2020 1:08 am

Re: Resalta solo la fila de celdas seleccionada

Notapor xiseme » Sab Ago 08, 2020 7:45 pm

:shock: Pues eso justamente es lo que ya está.
Es para ti la tarea de adaptar/ajustar a tus requisitos/gustos.
Fíjate en
Código: Seleccionar todo   Expandir vistaContraer vista
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

TC= transparencia.columna CC= color.columna TF= transparencia.fila ....
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.
xiseme
 
Mensajes: 1908
Registrado: Lun Nov 24, 2008 1:13 pm


Volver a Calc

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 1 invitado