Условное форматирование. сделать на кнопочку условие.

[ink-service]

Доброго дня. Например Мне постоянно нужно к колонке применить условие "найти повторяющиеся значения и выделить цветом".
Делаю так. Выделяю колонку - Условное форматирование - Условие - заполняю "не уникально" выбираю стиль и жму ОК..
получаю результат..
Но за день мне нужно это действие раз 20 сделать проверяя разные файлы))..
как мне это вывести на кнопочку?.. Чтоб открыл лист, выделил колонку и нажал кнопку и получил результат)

[economist]

Вложен файл. Код на VBA, чтобы не тратить время на грабельки.

[ink-service]

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

[economist]

Макрос можно скопировать в каждую нужную книгу ODS. Либо скопировать его в библиотеку Мои макросы или Макросы LibreOffice. Но тогда будет вопрос с кнопкой.

Лучший способ вызова - Сервис - Настройка - Клавиатура - Макросы - FillDub - Назначить

Макросу для работы всегда нужны выделенные ячейки.

А что такое "Общая книга"?  Если Общий доступ (Сервис - Совместно...) - то в нем всё работает.

[ink-service]

Я скопировал Ваш код, и вставил в Новом Модуле  в "Мои Макросы и диалоги". Вывел кнопкой на панель инструментов.
Открываю Файлик Выделяю ячейку, жму на панели инструментов кнопочку макроса и он пишет чтоб Выделить ячейки".. ( и не срабатывает
В Вашей книге все работает.
что я не так делаю?  спасибо

как понимаю в чем то аказия в кнопочке Вашей созданой. т.к. В вашем листе моя выведенная кнопка тоже не работает.
Макрос копировал просто выделил Ctrl+V -и-  Ctri+C

[eeigor]

Послушайте, ситуация несколько упростится, если данные с дубликатами можно сортировать по этому полю. Так, можно? Тогда всё-таки лучше задействовать штатный механизм, что использовал автор темы. В этом случае будет достаточно и одного цвета, поскольку все дубликаты будут идти "строго вместе", группами.

[economist]

Открываю Файлик Выделяю ячейку, жму на панели инструментов кнопочку макроса и он пишет чтоб Выделить ячейки"..

Правильно пишет, нужно выделить минимум 2+ ячейки.


Беглый анализ показал что макросы в библиотеке Мои макросы и диалоги - не
поддерживают опцию модуля Option VBASupport 1, то есть теряют контекст выполнения.
А значит VBA-строки вида:

Set ra = Intersect(Selection, ActiveSheet.UsedRange)

нужно переписывать на "родном" LO Basic API, заменяя одно слово - несколькими строками. Это те самые "грабельки", помочь с которыми я не могу ввиду дефицита времени.   

[sokol92]

Как обычно, у А. Питоньяка есть все необходимое. Выделите ячейки и примените следующий макрос. Можно в этом макросе изменить имя стиля не требуемое, поместить макрос в библиотеку приложения и повесить на подходящее сочетание клавиш.

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

Sub SetConditionalStyle
 Dim oRange        'Cell range to use
 Dim oConFormat    'Conditional format object
 Dim oCondition(1) As New com.sun.star.beans.PropertyValue

 REM Sheets support returning a cell range based on UI type names.
 oRange = ThisComponent.CurrentSelection
 oConFormat = oRange.ConditionalFormat
 
 oCondition(0).Name = "Operator"
 oCondition(0).Value = 10
 oCondition(1).Name = "StyleName"
 oCondition(1).Value = "Neutral"
 oConFormat.addNew(oCondition())
 oRange.ConditionalFormat = oConFormat
End Sub

[eeigor]

Код не вызывает сомнений. Кроме одного момента: почему константа 10? И это верно. @sokol92, по этой причине я отложил эту задачу...

com.sun.star.sheet.ConditionFormatOperator.DUPLICATE
const long    DUPLICATE = 8

Но вот, кажется, и нашёл... Ну, нельзя же так!  
com.sun.star.sheet.ConditionOperator2.DUPLICATE
const long    DUPLICATE = 10

И, похоже, при попытке выделить весь столбец, а затем отсечь CurrentRegion перестал работать метод курсора
oCursor.collapseToCurrentRegion()
Однако, раньше, до обновления, не припомню такого...

[ink-service]

Спасибо всем)).

Беглый анализ показал что макросы в библиотеке Мои макросы и диалоги - не
поддерживают опцию модуля Option VBASupport 1,

теперь понятно почему не работает..   Я там именно и сохранил..

Как обычно, у А. Питоньяка есть все необходимое.

вот это работает.. спасибо..
НО , макрос  economist - выделял дубликаты разными цветами, и мне это понравилось).
Можно ли в этом коде что-то поправить и получить такой же результат?)

[eeigor]

Можно ли в этом коде что-то поправить и получить такой же результат?

Нет, нельзя. Используется встроенная функциональность. Результат станет нагляднее, если данные можно отсортировать.
А для удобства выделения данных есть решение, позволяющее выделять весь столбец целиком. Реально удобно.

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

Sub SetConditionalStyle
    Call SelectData
    <...>
End Sub

Sub SelectData
   oCell = getActiveCell()
   oRange = getCurrentRegion(oCell)
   ThisComponent.CurrentController.select(oRange)
End Sub

Функции getActiveCell и getCurrentRegion найдете здесь.

Но вариант от @economist может быть переписан без использования кода VBA.

[sokol92]

В названии темы упоминается "Условное форматирование" (УФ). Вариант из ответа #7 - именно УФ, при изменении данных диапазона цвета будут меняться автоматически. Макрос из ответа #1 (как в нем указано, взят с сайта excelvba.ru) не использует УФ, а раскрашивает непосредственно ячейки. Как справедливо указано в предыдущем ответе, этот макрос несложно переписать с использованием "родных" объектов LO.

[ink-service]

Понял.. Но переписать мне сложно, я в этом почти не понимаю (..  пока только пытаюсь вникнуть в написание подобного).
В принципе задача поставленная решена, работает.. Просто хотелки приходят с аппетитом).

[sokol92]

Хорошо, завтра напишу макрос для подобной раскраски произвольных диапазонов.

[sokol92]

Попробуйте вариант с "твердой" раскраской дублирующихся значений ячеек. Для раскраски выделенных ячеек можно вызвать PaintDuplSelection (или PaintDupl без указания параметров).
Программа обрабатывает только непустые ячейки (то есть, можно безопасно выделять строки и столбцы целиком).
Можно переписать макросы в библиотеку приложения и назначить удобное сочетание клавиш.
Тестировал на 30 000 ячеек, работает несколько секунд.

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

Option Compatible
Option Explicit

' Раскрашивает дублирующиеся значения ячеек в разные цвета.
' Параметры:
' oDoc    документ Calc. Если не задан, то ThisComponent.
' oRange  диапазон(ы) ячеек для раскрашивания. Все диапазоны должны быть на одном листе. Если не задан то CurrentSelection.
' aColors массив цветов.
'
' Пустые ячейки не обрабатываются.
' По мотивам макроса: http://excelvba.ru/code/DuplicatesColors
Sub PaintDupl(Optional ByVal oDoc, Optional ByVal oRange, Optional ByVal aColors)
  Dim oCell, oCells, oMap, nCells As Long, nDupl As Long, ind as Long, s As String, i As Long
  If IsMissing(oDoc) Then oDoc=ThisComponent
  If IsMissing(oRange) Then oRange=oDoc.CurrentSelection
  If IsMissing(aColors) Then aColors=Array(12900829, 15849925, 14408946, 14610923, _
     15986394, 14281213, 14277081, 9944516, 14994616, 12040422, 12379352, 15921906, _
     14336204, 15261367, 14281213)
   
  If oRange.supportsService("com.sun.star.sheet.SheetCell") Then Exit Sub  ' одна ячейка
  oRange=oRange.queryContentCells(1+2+4+16)  ' числа, даты, строки, формулы
  oCells=oRange.Cells
  oMap=com.sun.star.container.EnumerableMap.create("string", "any")
  ind=-1
 
  For Each oCell In oCells
    nCells=nCells+1
    s=oCell.String
    If s<>"" Then
      If oMap.containsKey(s) Then
        i=oMap.get(s)
        If i=-1 Then
          ind=ind+1
          If ind>Ubound(aColors) Then ind=0
          oMap.put s, aColors(ind)
          nDupl=nDupl+2
        Else
          nDupl=nDupl+1  
        End If
      Else
        oMap.put s, -1
      End If  
    End If      
  Next oCell

  For Each oCell In oCells
    s=oCell.String
    If s<>"" Then
      i=oMap.get(s)
      If oCell.CellBackColor<>i Then oCell.CellBackColor=i
    End If
  Next oCell    
     
  Msgbox "Всего непустых ячеек: " & nCells & " дублей: " & nDupl

End Sub

' --------------------------------------------------------------------------------------------------------------------
' Раскрашивает дублирующиеся значения выбранных ячеек в разные цвета
Sub PaintDuplSelection
 PaintDupl
End Sub