Макросы

Автор Павел, 23 февраля 2024, 13:29

0 Пользователи и 1 гость просматривают эту тему.

Павел

приветствую форумчане.
Проблема следующая:
в экселе понаделал макросов под кнопочки для изменения вида таблицы с большим колличесвом данных.
Пришлось пересесть на Либре офис, на выходе:
1. макросы со скрытием столбцов - работает без нареканий
2. макросы с автофильтром по одному значению - с горем, но подправил.
3. Макросы с фильтрацией по нескольким значениям в одном столбце и фильтрация по значениям в нескольких столбцах - вообще отказываются работать.

Просьба: помогите с листингом макроса для либре, или киньте ссылочку, если проблема решена ранее.
заранее спесибо...

sokol92

Владимир.

Павел

спасибо, почитал, но по моему там много лишлего.

нужно чтобы после выполнения макроса в таблице остались только мальчики студены (для примера)

причем фильтр был в строке №7

sokol92

Вот макрос из знаменитой книги Питоньяка (ссылка на книгу в начале макроса), адаптированный к Вашему примеру. Я к нему добавил показ стрелочек автофильтра.

' Пример установки автофильтра из книги А.Питоньяка [OOME_4_0.odt](https://www.pitonyak.org/OOME_4_0.odt).
Sub SimpleSheetFilter_2()
  Dim oSheet          ' Sheet to filter.
  Dim oRange          ' Range to be filtered.
  Dim oFilterDesc     ' Filter descriptor.
  Dim oFields(1) As New com.sun.star.sheet.TableFilterField
 
  oSheet = ThisComponent.getSheets().getByIndex(0)
 
  oRange = oSheet.getCellRangeByName("A7:C23")
 
  oFilterDesc = oRange.createFilterDescriptor(True)

  With oFields(0)   
    .Field = 0              ' Filter column A.
    .IsNumeric = False      ' Use a string, not a number.
    .StringValue = "м"       
    .Operator = com.sun.star.sheet.FilterOperator.EQUAL
  End With

  REM Setup a field that requires both conditions
  With oFields(1)
    .Connection = com.sun.star.sheet.FilterConnection.AND
    .Field = 2              ' Filter column C.
    .IsNumeric = False
    .StringValue = "с"   
    .Operator = com.sun.star.sheet.FilterOperator.EQUAL
  End With

  oFilterDesc.setFilterFields(oFields())
  oFilterDesc.ContainsHeader = True
  oRange.filter(oFilterDesc)
 
  GetSheetFilterDBRange(oSheet).Autofilter=True  ' To show the filter arrows (by @sokol92)
End Sub

' Возвращает DataBaseRange для автофильтра листа или Nothing.
Function GetSheetFilterDBRange(oSheet) as Object
  Dim i as Long, oDoc
  GetSheetFilterDBRange=Nothing
  oDoc=oSheet.Drawpage.Forms.Parent
  i=oSheet.RangeAddress.Sheet
  With oDoc.getPropertyValue("UnnamedDatabaseRanges")
    If .hasByTable(i) Then GetSheetFilterDBRange=.getByTable(i)
  End With
End Function

Владимир.