Pergunte aqui
0

Destacar a linha da célula selecionada

perguntadas 2020-07-03 03:26:31 +0200

imagem do gravatar de Orlando

updated 2020-07-09 17:53:20 +0200

imagem do gravatar de Schiavinatto

Olá, Pessoal!

Estou tentando no Calc um código para destacar só a linha da célula selecionada, limitada à tabela: A6 a J2400, protegida sem senha e conservando a formatação dessa tabela.

.

Grato pela atenção!

Orlando Souza

8)

editar alterar tag assinalar como ofensivo fechar mesclar Excluir

2 Respostas

1

respondidas 2020-07-05 17:10:39 +0200

imagem do gravatar de Orlando

updated 2020-07-09 22:55:18 +0200

Seguem códigos para inserir no "Module1", exclusivo, do Basic (Alt+F11), depois atribuir a ação DestacarEventos na opção Seleção alterada (em Planilha->Eventos de planilha...):

Sub DestacarEventos
DestacarX()
end sub

Sub DestacarX(Optional nClasse, Optional Back As Integer)

Dim Altura
Dim DDestac
Dim ETQ As String
Dim i As Integer
Dim LinhaSel
Dim Largura
Dim oControlador As Object
Dim oCursor As Object
Dim oDib As Object
Dim oDoc As Object
Dim oDP As Object
Dim oSel As Object
Dim pos
Dim shape1 As Object
Dim size

ETQ= "BarraDestacar"
If IsMissing(Back) Then Back = 2 

oDoc = ThisComponent
oControlador = oDoc.CurrentController
oSel = oControlador.Selection

If Not (oSel.ImplementationName = "ScCellObj") Then
    GoTo Fin
End If

oDP = oSel.getSpreadSheet().getDrawPage()

LinhaSel = oSel.getRangeAddress.StartRow

If IsMissing(nClasse) or nClasse="" Then
    oCursor = oSel.getSpreadSheet.createCursorByRange(oSel)
    oCursor.gotoEndOfUsedArea( False )
    nClasse= Replace(oCursor.AbsoluteName, ".",  ".A6:")        'começar na linha 6
End If
DDestac = oControlador.ActiveSheet.getCellRangeByName(nClasse)      
If LinhaSel > DDestac.getRangeAddress.EndRow Or LinhaSel < DDestac.getRangeAddress.StartRow Then
    For i= (oDP.getCount - 1) To 0 Step -1
        oDib = oDP.getByIndex(i)
        If oDib.Name = ETQ & "Linha" Then
            oDP.Remove(oDib)
        End If
    Next
    GoTo Fin
Else
    For i= (oDP.getCount - 1) To 0 Step -1
        oDib = oDP.getByIndex(i)
        If oDib.Name = ETQ & "Linha" 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 & "Linha"
            End If
            .setSize (oTam) 
            .MoveProtect = True
            .LineStyle = com.sun.star.drawing.LineStyle.NONE
            .FillColor = RGB( 75,75,75 ) 'cor
            .FillTransparence = 85       'transparência em %
            .LayerID = Back
            .ZOrder = 0
        End With
         oDP.Add(oForma)
    Next
End If

Seguir:
oCursor = DDestac.getSpreadSheet.createCursorByRange(DDestac)
Largura = oCursor.Size.Width
Altura = oCursor.Size.Height    
oCursor.gotoEndOfUsedArea(False)

Dim index1 As Integer 
For i=0 To oDP.getCount - 1
    oDib = oDP.getByIndex(i)
    If  oDib.Name  = ETQ & "Linha" Then
        index1 = i
    End If
Next

shape1 = oDP.getByIndex(index1) 

pos = oSel.Position
size = oSel.Size
size.Width = Largura

pos.X = DDestac.Position.X
shape1.setPosition(pos)
shape1.setSize(size)

pos = oSel.Position
size = oSel.Size    
size.Height = Altura

Fin:
Exit Sub

End Sub

Fonte: Fóruns da comunidade Apache OpenOffice (e LibreOffice)

Ps: O destaque na linha aparecerá entre a col A e a última usada.

editar assinalar como ofensivo Excluir Link mais

Comentários

Ola @Orlando, parabéns pela divulgação, será muito útil.

Mas estou testando em Win10+LibO6.4.5.2 e esta aparecendo esta imagem, mesmo que limpo e salvo volta aparecer.

Descrição da imagem

São várias, ficam sobrepostas.

imagem do gravatar de SchiavinattoSchiavinatto ( 2020-07-10 00:45:34 +0200 )editar
1

Oi, @Schiavinatto

Eu vou comparar com o arquivo original: ResaltadoDeFilaColumaPruebas, localizado na origem de Fonte informada no final da minha resposta.

Tudo indica que exclui o comando correspondente, quando tirei o destaque em colunas.

imagem do gravatar de OrlandoOrlando ( 2020-07-10 03:35:19 +0200 )editar

@Orlando, a dimensão da imagem e 5, x 0,3, esta dimensão aparece a partir da linha 64 da macro.

A macro não muda o fundo e sim coloca uma mascara semi transparente por cima, interessante....

Abraço.

imagem do gravatar de SchiavinattoSchiavinatto ( 2020-07-10 04:05:07 +0200 )editar

@Orlando, de uma olhada na Plan2 e macros Module2.

A macro é só para lançar o numero da linha ativa em A1 e voltar para a célula de origem.

A cor é por validação, com base na célula A1.

Arquivo teste

É necessário clique duplo.

imagem do gravatar de SchiavinattoSchiavinatto ( 2020-07-10 05:45:23 +0200 )editar
0

respondidas 2020-07-06 19:06:12 +0200

imagem do gravatar de Conrado

updated 2020-07-06 19:08:05 +0200

@Orlando

Segue o código corrigido e com explicações (rem) sobre as linhas de comando:

Option Explicit

Sub ResaltarSeleccion()
Dim oDoc As Object
Dim oControlador As Object
Dim oSel As Object
Dim oRango As Object
Dim oRango1 As Object
Dim oRango2 As Object
Dim oColunaInicio, oColunaFim, oLinhaInicio, oLinhaFim as Long
Dim Coluna, Linha as Long
Dim sPassword as String 

    oDoc = ThisComponent
    oControlador = oDoc.CurrentController
    oSel = oControlador.Selection

    rem Aqui você irá informar o tamanho da sua tabela. Coluna A = 0, Linha 1 = 0
    oColunaInicio = 0
    oColunaFim = 9
    oLinhaInicio = 5
    oLinhaFim = 2399

    rem Aqui coloque a senha da planilha 
    sPassword = ""

    If oSel.ImplementationName = "ScCellObj" Then
        oRango = oControlador.getVisibleRange

        rem Aqui é colocado o número da coluna e da linha selecionada
        Coluna = oSel.CellAddress.Column
        Linha = oSel.CellAddress.Row

        rem Rango1 ativa a formatação para Linha
        oRango1 = oSel.SpreadSheet.getCellRangeByPosition( oSel.CellAddress.Column, oLinhaInicio, oSel.CellAddress.Column, oLinhaFim )
        rem Rango2 ativa a formatação para Coluna
        oRango2 = oSel.SpreadSheet.getCellRangeByPosition( oColunaInicio, oSel.CellAddress.Row, oColunaFim, oSel.CellAddress.Row )
        oRango = oSel.SpreadSheet.createCursor()
        rem desativa a planilha com a senha
        oControlador.getActiveSheet.unprotect(sPassword)
        rem Reseta a Formatação
        oRango.CellStyle = "Default"

        rem Aplica a formatação desde que a célula selecionada esteja dentro do tamanho da tabela indicada
        if Coluna >= oColunaInicio and Coluna <= oColunaFim and Linha >= oLinhaInicio and Linha <= oLinhaFim Then
            oRango1.CellStyle = "Resaltado"
            oRango2.CellStyle = "Resaltado"
        End If

        rem ativa a planilha com a senha
        oControlador.getActiveSheet.protect(sPassword)
    End If

End Sub

Para manter a sua formatação, antes de mais nada, precisa criar as formatações no Calc.

Para criar as formatações, faça o seguinte:

1- F11 (Gerenciar Estilos)

2 - Em estilos de Célula, clique com o botão direito na área branca

3 - Clique em Novo ou Modificar o Estilo selecionado

4 - Dê um nome ao estilho (será utilizado na macro), e formate ao seu gosto

editar assinalar como ofensivo Excluir Link mais

Comentários

bom dia, @Conrado!

sua sugestão destaca a coluna e não conserva a formatação na tabela, como segue:

https://www.dropbox.com/s/escg7n5oddn...

imagem do gravatar de OrlandoOrlando ( 2020-07-07 05:37:15 +0200 )editar

@Orlando, para que sua formatação permaneça, como eu havia informado na reposta, você precisa criar um Estilo com a formatação utilizada e vincular à macro (substituir o "Default" pelo estilo criado. Apenas dessa forma a formatação se manterá na sua planilha, destacando a linha.

imagem do gravatar de ConradoConrado ( 2020-07-07 12:42:55 +0200 )editar

Oi, @Conrado

Refiz o passo-passo na sua resposta e o resultado continua igual à planilha-modelo que eu anexei no comentário anterior.

Obrigado!

imagem do gravatar de OrlandoOrlando ( 2020-07-08 00:58:02 +0200 )editar
Login/Registrar para responder

Ferramentas de perguntas

1 seguidor

Estatísticas

Perguntadas: 2020-07-03 03:26:31 +0200

Lidas: 126 vezes

Última atualização: Jul 09