Скрыть строки / прослушиватель автофильтра - OpenOffice Basic

Мне нужно, чтобы dev Listener обнаруживал изменения параметра isVisible для строк в calc.

Еще лучше было бы, чтобы у меня был прослушиватель изменений автофильтра — это тоже выше моих сил. Я был бы признателен за помощь в любом или обоих решениях.

XEventListener и XModifyListener не обнаруживают эти изменения. Может попробовать использовать XChangesListener XChangesNotifier? ‹- в любом случае, у меня тоже были проблемы с его реализацией для тестов

Sub add_eventsListener
    Dim ePrefix As String, eService As String

    ePrefix = "event_"
    eService = "com.sun.star.document.XEventListener"

    If IsNull(mEventHandler) Then
        mEventHandler = CreateUnoListener(ePrefix, eService)
        ThisComponent.addEventListener(mEventHandler)
    EndIf
End Sub

Sub event_notifyEvent(oEvent)
    msgbox "event: " & oEvent.EventName 
End Sub


Sub add_modifyListener(ByRef Sheet)
    Dim ePrefix As String : Dim eService As String
    Dim cell as Object

    ePrefix = "event_"
    eService = "com.sun.star.util.XModifyListener"

    cell = Sheet.getCellrangeByName("A2:A9") 

    If IsNull(mModifyHandler) Then
        mModifyHandler = CreateUnoListener(ePrefix, eService)
        cell.AddModifyListener(mModifyHandler)
    EndIf
End Sub

Sub event_modified(oEvent)
    'If oEvent.Source.CellAddress.Column <> 0 Then Exit Sub
    Msgbox "changes made"
End Sub

где mEventHandler и mModifyHandler являются глобальными

Sub add_autofilter(ByRef Sheet)
On Error GoTo Err
    Dim Range As New com.sun.star.table.CellRangeAddress
    Dim FilterOn As Boolean, dRange As Object, cell As Object, row%
    FilterOn = False

    cell = Sheet.getCellRangeByName("A1")
    row = getLastRow(Sheet)

On Error Resume Next
    dRange = ThisComponent.DatabaseRanges.getByName("Symbols")
    FilterOn = dRange.AutoFilter
On Error GoTo 0 : On Error GoTo Err

    If FilterOn Then Exit Sub

    With Range
        .Sheet = 0
        .StartColumn = 0
        .StartRow = 0
        .EndColumn = 0
        .EndRow = row
    End With

    'Range = Sheet.getCellRangeByPosition(0, 0, 0, row)
    ThisComponent.DatabaseRanges.addNewByName("Symbols", Range)
    ThisComponent.DatabaseRanges.getByName("Symbols").AutoFilter = True
Exit Sub
Err:
End Sub


Function getLastRow(ByRef Sheet) As Integer
    Dim cursor
    cursor = Sheet.createCursor()
    cursor.gotoEndOfUsedArea(false)
    getLastRow = cursor.getRangeAddress().EndRow
End Function

listener handler basic
person s1w_    schedule 22.03.2017    source источник

Ответы (1)


arrow_upward
0
arrow_downward

Пока я жду рационального решения, я нашел обходной путь. Если прослушиватель автофильтра будет невозможен, мне придется остаться с этим:

добавить формулу в какую-либо ячейку: (старое решение, проверьте EDIT ниже)

"=ЕСЛИ(ТЕПЕРЬ()>0;СТРОКИ_ФИЛЬТРИРОВАННЫЕ();0)"

Function ROWS_FILTERED() As Integer 
    If Freezed Then Exit Function
    Dim i%, rows%, Sheet As Object : Sheet = ThisComponent.Sheets(0) 
    rows = getLastRow(Sheet)
    For i = 1 to getLastRow(Sheet)   'row 0 is for labels
        If Sheet.Rows(i).IsVisible = True Then
            rows = rows - 1
        End If
    Next i
    ROWS_FILTERED = rows
End Function

И если вы вносите изменения там, где вычислений не ожидается, просто назначьте True на Global Freezed на это время

РЕДАКТИРОВАТЬ: эврика! Я нашел эту блестящую формулу, которая работает и обновляется без обходного пути:

Эврика! Mimo że nie osiągnąlem rezultatu z czystego BASIC'a, znalazłem genialną Formula, która się odnosi bezposrednio do autofiltra!! я обновляю без обязательств:

"=ПРОМЕЖУТОЧНЫЙ ИТОГ(3;A2:A" & getLastRow(Sheet) + 1 & ")"

не забудьте включить getLastRow(ByRef Sheet) функцию в код

person s1w_    schedule 27.03.2017