Нужен пример макроса сортировки таблицы с помощью настраиваемого списка

[DimS]

Подскажите секрет, как записать макрорекордером в Сalk сортировку таблицы с помощью пользовательского списка...
или, может, есть пример макроса сортировки с помощью списка?




Version: 7.1.3.2 (x64) / LibreOffice Community

[sokol92]

В LO макрорекордер не так полезен, так в Excel. Макрорекордер (в лучшем случае) записывает Ваши действия как поледовательный вызов команд "Диспетчера". Гораздо эффективнее обращаться к методам UNO.
К счастью, есть книга Питоньяка OOME_4_0.odt, где есть содержательные (чуть устаревшие) примеры, связанные с сортировкой.
Про пользовательские списки в сортировке - см. здесь, атрибуты (свойства) IsUserListEnabled, UserListIndex.

[DimS]

Спасибо! но, к сожалению,  сложно...

[sokol92]

Подготовил учебный пример:

Код Выделить Развернуть

Sub TestUserList()
 Dim oDoc, oRange
 Dim oSortFields(0) as new com.sun.star.table.TableSortField
 Dim oSortDesc(3)   as new com.sun.star.beans.PropertyValue

 oDoc=StarDesktop.loadComponentFromURL("private:factory/scalc", "_blank", 0, Array())   ' новая книга Calc
 oRange=oDoc.Sheets(0).getCellRangeByName("A1:A2")   ' диапазон для сортировки
 oRange.setDataArray Array(Array("Вт"), Array("Пн")) ' присвоили значения: Вт, Пн
 
 oSortFields(0).Field = 0                 ' столбец A              
 oSortFields(0).IsAscending = True        ' по возрастанию

 oSortDesc(0).Name = "SortFields"        
 oSortDesc(0).Value = oSortFields()       ' поля сортировки
 oSortDesc(1).Name = "ContainsHeader"
 oSortDesc(1).Value = False               ' нет заголовка столбцов
 oSortDesc(2).Name = "IsUserListEnabled"
 oSortDesc(2).Value = True                ' сортировка по встроенному пользовательскому списку
 oSortDesc(3).Name = "UserListIndex"
 oSortDesc(3).Value = 0                   ' номер пользовательского списка (Пн, Вт, Ср, ...)

 oRange.Sort oSortDesc                    ' сортируем
End Sub


Реализация сортировки по пользовательскому списку в Calc (как и в Excel) нельзя назвать удачной, поскольку список привязан к экземпляру LO, а не к документу. Следовательно, никто другой так сортировать не может, если только список не входит в инсталляцию LO.

Проще разместить список для сортировки непосредственно в документе; при необходимости сортировки дипазона по этому списку создать дополнительный столбец, заполнить его с помощью функции ПОИСКПОЗ (по списку) и сортировать по этому дополнительному столбцу.

[DimS]

а нужно именно чтобы на другом пк работало (((.
был у JohnSUN макрос "SortByTitles" но он только один столбец сортирует, а как его переделать не пойму! (((

[sokol92]

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

[DimS]

вот пример

[sokol92]

Занесите в A5 формулу

=ПОИСКПОЗ(B5;U$4:U$9;0)

протяните вниз и сортируйте стандартным образом. Можете скрыть столбец A.

[DimS]

к сожалению с формулами не вариант, т.к. таблица-часть книги с макросами, а пользователь очень далёк, ему и создание стандартными средствами пользовательского списка волшебством кажется...

[sokol92]

Так это я не пользователю, а макросу давал рекомендации.

[DimS]

Владимир, лично мне Ваше предложение нравится простотой. Но, если я скажу девушке - пользователю чтобы она, добавив в таблицу строку, отобразила столбец, протянула формулу, скрыла столбец и отсортировала....

[sokol92]

Ладно, поможем девушке (позднее). В этом случае можно обойтись без дополнительного столбца.

[eeigor]

@sokol92 предложил отличный вариант. Самый простой, даже если и надо подучиться...

Ваш пример на листе для Excel работает с пользовательскими списками, но делает это динамически (!) и "подчищает" за собой (добавляет с листа, извлекает, сортирует и удаляет по окончании работы).
Если такой вариант вас заинтересует, то работаем с этим...

Код Выделить Развернуть

Dim aUserLists$()
oSettings = createUnoService("com.sun.star.sheet.GlobalSheetSettings")
aUserLists$ = oSettings.getPropertyValue("UserLists")

ReDim Preserve aUserLists(UBound(aUserLists) + 1)
aUserLists(UBound(aUserLists)) = "пункт1,пункт2,пункт3"  'ваши пункты списка, разделённые запятой
oSettings.setPropertyValue("UserLists", aUserLists)

Готово. А как фильтровать, @sokol92 показал выше (Ответ #3).

UPD
Присвойте диапазон со списком переменной массива (за один приём) и объедините значения функцией Join(..., ","), а результирующую строку добавьте в массив aUserLists в конец, а после использования удалите последний элемент.

UPD2
В LO Calc нет подобного Excel метода
Application.GetCustomListNum(ListArray)
Но его нетрудно реализовать - перебором элементов массива aUserLists и их сравнением с вашей строкой sList (значения, разделённые запятой). При желании можно работать с массивом на листе по аналогии с Excel (аргумент ListArray). Тогда объединение элементов выполните в теле этой функции.
nIndex = Application.GetCustomListNum(Worksheets("1").Range("u4:u9").Value)  'где ListArray = .Range("u4:u9").Value

Код Выделить Развернуть

For i = 0 To UBound(aUserLists)
   If InStr(1, aUserLists(i), sList, 1) <> 0 Then
       nPos = i
       Exit For
   End If
Next

[sokol92]

Макрос для сортировки - SortByRegions. В документ, кроме макроса, добавлены именные диапазоны для таблицы и списка районов.
Ниже приведены тексты макросов (кроме утилит).

Код Выделить Развернуть

Option Explicit
Option Compatible

' Сортирует таблицу по порядку районов
Sub SortByRegions
  Dim oRange, oRange1, aRegions, oMap, i As Long, v, arr, s As String
 
  oRange=Range_CurrentRegion(ThisComponent.NamedRanges.GetByName("Table_1").ReferredCells, True)  ' таблица для сортировки
  aRegions=ThisComponent.NamedRanges.GetByName("T_sort").ReferredCells.DataArray  ' диапазон регионов
 
  oMap = com.sun.star.container.EnumerableMap.create("string", "any")
  For i=0 To Ubound(aRegions)
    oMap.put lCase(aRegions(i)(0)), i
  Next i
 
  ' Добавляем к наименованию района слева номер из 4 цифр
  oRange1=oRange.getCellRangeByPosition(0, 0, 0, oRange.Rows.Count-1)  ' первый столбец диапазона oRange
  arr=oRange1.DataArray
  For i=1 To Ubound(arr)
    s=arr(i)(0)
    If oMap.containsKey(lCase(s)) Then
      s=Format(oMap.get(lCase(s)), "0000") & s
    Else
      s="9999" & s
    End If
    arr(i)(0)=s
  Next i
  oRange1.DataArray=arr     

  SortTable(oRange, 0)  ' сортируем по первому столбцу диапазона
 
  ' Убираем первые 4 цифры
  oRange1=oRange.getCellRangeByPosition(0, 0, 0, oRange.Rows.Count-1)  ' первый столбец диапазона oRange
  arr=oRange1.DataArray
  For i=1 To Ubound(arr)
    arr(i)(0)=Mid(arr(i)(0), 5)
  Next i 
  oRange1.DataArray=arr

End Sub

' --------------------------------------------------------------------------------------------------------------------------------------
' Сортируем диапазон oRange по столбцу i
Sub SortTable(ByVal oRange, ByVal i As Long)
  Dim oSortFields(0) as new com.sun.star.table.TableSortField
  Dim oSortDesc(1)   as new com.sun.star.beans.PropertyValue

  oSortFields(0).Field = i                 ' столбец i
  oSortFields(0).IsAscending = True        ' по возрастанию
  oSortDesc(0).Name = "SortFields"         
  oSortDesc(0).Value = oSortFields()       ' поля сортировки
  oSortDesc(1).Name = "ContainsHeader"
  oSortDesc(1).Value = True                ' есть заголовок столбцов

  oRange.Sort oSortDesc                    ' сортируем   
End Sub

Пробуйте и отсылайте девушке.

[DimS]

Владимир, спасибо, работает! А реализация неожиданная!