Função para retornar a célula ativa?

Olá,
Estou querendo uma macro para criar uma função que tenha como resultado a linha da célula selecionada.
Por exemplo: a função estando na célula B2 quando clicado na célula A7 a célula B2 assume o valor 7. Clicando com o mouse na célula Z9, a célula B2 apresentará dessa vez o valor 9.

No excel ela é assim:

Private Function LinhaAtual() As String
Application.Volatile
LinhaAtual = ActiveCell.Address
End Function

Obrigado pela atenção.

Olá,

No LIbreOffice Basic você tem que trabalhar com a Seleção Atual, porque não existe um objeto/método ActiveCell. Mas na internet conseguimos exemplos de funções escritas por usuários que retornam a célula ativa. Uma delas encontrei no AskLibO (Inglês) e usei dentro da função LinhaAtual:

Function LinhaAtual() As String
   LinhaAtual = ActiveCell.CellAddress.Row + 1
End Function
'-------------------------------------------------------------------------------------------'
Function ActiveCell (Optional iSheet As Long, Optional oDoc As Variant) As Object
'Função que devolverá a Célula Ativa'
'Fonte: JonhSUM (https://ask.libreoffice.org/t/access-current-cell-from-macro-in-calc-solved/17325/2)'
Dim arrayOfString ()    ' An array of text strings to parse'
Dim lRow&, lColumn&     ' The coordinates of the desired cell'
Dim tmpString$          ' Time line'
Dim oCurrentController  ' controller of the analyzed document'
Dim oSheets As Variant  ' All the pages of the current book'
Dim oSheet As Variant   ' Active (test) page of the book'
REM Check input parameters and set the default values ​​:
    If IsMissing (oDoc) Then oDoc = ThisComponent
    If NOT oDoc.SupportsService ("com.sun.star.sheet.SpreadsheetDocument") Then Exit Function
    oCurrentController = oDoc.getCurrentController()
    If IsMissing (iSheet) Then
        oSheet = oCurrentController.getActiveSheet()
        iSheet = oSheet.getRangeAddress().Sheet
    Else
        If (iSheet < 0) Then Exit Function
        oSheets = ThisComponent.getSheets()
        If (iSheet>= oSheets.getCount ()) Then Exit Function
        oSheet = oSheets.getByIndex (iSheet)
    EndIf
    tmpString = oCurrentController.getViewData()
    arrayOfString () = Split (tmpString, ";")
    If UBound (arrayOfString) <( 3 + iSheet) Then Exit Function
    tmpString = arrayOfString ( 3 + iSheet)
    If InStr (tmpString, "+")> 0 Then
        arrayOfString () = Split (tmpString, "+")
    Else
        arrayOfString () = Split (tmpString, "/")
    EndIf
    lColumn = CLng (arrayOfString ( 0) )
    lRow = CLng (arrayOfString ( 1) )
    Set ActiveCell = oSheet.getCellByPosition (lColumn, lRow)
End Function
'-------------------------------------------------------------------------------------------'

Baseando ainda no seu exemplo, acredito que será preciso uma macro que force o recálculo do documento toda vez que se clicar em uma nova célula.

Associe a macro abaixo ao evento Seleção Alterada dos “Eventos de Planilha” (Menu Planilha > Eventos de Planilha)

Sub SelecaoAltarada( oCelula )
    If oCelula.ImplementationName <> "ScCellObj" Then Exit Sub
    ThisComponent.CalculateAll
End Sub

No lugar da macro, é possível usar o atalho Shift+Ctrl+F9 para forçar recalcular.


Edição: Solução alternativa


Como descrito nos comentários, mandar recalcular tudo, a cada nova seleção, tornou lento e inviável o uso em uma planilha grande e, possivelmente, cheia de fórmulas e cálculos.

Mas há outra opção. Substituindo a macro acima, vinculada ao evento Seleção Atual, pela a rotina:

Sub SelecaoAltarada( oCelula )
    If oCelula.ImplementationName <> "ScCellObj" Then Exit Sub
    oPlan = oCelula.Spreadsheet    
    oPlan.getCellRangeByName( "B2" ).String = LinhaAtual
End Sub

Com ela não é necessário escrever “=LINHAATUAL()” na célula B2. A macro já recupera o valor da função e o insere diretamente na célula.


Atte,
1 Like

Muito obrigado! Funcionou perfeitamente num arquivo em branco. Mas na minha planilha que está bastante grande fica muito lento quando uso essa macro e portanto inviável.

Qual é o tamanho de sua planilha? Quantas linhas tem?

tem 3659 linhas e está com mais de 5M

@thiago_thigf, editei minha resposta para apresentar uma solução alternativa. Veja se agora vai funcionar direito em sua planilha.

Use a opção de compatibilidade do StarBasic

REM  *****  BASIC  *****
Option VBASupport 1
Sub Main
 msgbox ActiveCell.Address
End Sub