Форум поддержки пользователей. LibreOffice, Apache OpenOffice, OpenOffice.org

Форум поддержки пользователей. LibreOffice, Apache OpenOffice, OpenOffice.org

23 Апрель 2021, 00:18 *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

Войти
Новости: Здесь можно поблагодарить участников форума Улыбка
 
   Начало   Помощь Поиск Войти Регистрация    задать вопрос  
Страниц: 1 2 »   Вниз
  Печать  
Автор Тема: Условное форматирование. сделать на кнопочку условие.  (Прочитано 1023 раз)
0 Пользователей и 1 Гость смотрят эту тему.
ink-service
Участник
**
Offline Offline

Сообщений: 43


« Стартовое сообщение: 11 Март 2021, 10:29 »

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

Сообщений: 1 424


« Ответ #1: 11 Март 2021, 12:52 »

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

* КраситДублиКнопкаVBA.ods (11.77 Кб - загружено 15 раз.)
Записан

Руб. за сто, что Питоньяк
Любит водку и коньяк!
Потому что мне, без оных, -
Не понять его никак...
ink-service
Участник
**
Offline Offline

Сообщений: 43


« Ответ #2: 12 Март 2021, 09:52 »

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

Сообщений: 1 424


« Ответ #3: 12 Март 2021, 10:17 »

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

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

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

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

Записан

Руб. за сто, что Питоньяк
Любит водку и коньяк!
Потому что мне, без оных, -
Не понять его никак...
ink-service
Участник
**
Offline Offline

Сообщений: 43


« Ответ #4: 12 Март 2021, 10:41 »

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

как понимаю в чем то аказия в кнопочке Вашей созданой. т.к. В вашем листе моя выведенная кнопка тоже не работает.
Макрос копировал просто выделил Ctrl+V -и-  Ctri+C
« Последнее редактирование: 12 Март 2021, 10:47 от ink-service » Записан
eeigor
Форумчанин
***
Offline Offline

Пол: Мужской
Сообщений: 515



« Ответ #5: 12 Март 2021, 11:06 »

Послушайте, ситуация несколько упростится, если данные с дубликатами можно сортировать по этому полю. Так, можно? Тогда всё-таки лучше задействовать штатный механизм, что использовал автор темы. В этом случае будет достаточно и одного цвета, поскольку все дубликаты будут идти "строго вместе", группами.
« Последнее редактирование: 12 Март 2021, 11:10 от eeigor » Записан

Ubuntu 18.04 LTS • LO 7.1.1.2 Community
economist
Форумчанин
***
Offline Offline

Сообщений: 1 424


« Ответ #6: 12 Март 2021, 13:25 »

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

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


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

Set ra = Intersect(Selection, ActiveSheet.UsedRange)

нужно переписывать на "родном" LO Basic API, заменяя одно слово - несколькими строками. Это те самые "грабельки", помочь с которыми я не могу ввиду дефицита времени.   
« Последнее редактирование: 12 Март 2021, 13:43 от economist » Записан

Руб. за сто, что Питоньяк
Любит водку и коньяк!
Потому что мне, без оных, -
Не понять его никак...
sokol92
Форумчанин
***
Offline Offline

Пол: Мужской
Сообщений: 381


WWW
« Ответ #7: 12 Март 2021, 13:57 »

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

Код:
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
« Последнее редактирование: 12 Март 2021, 14:08 от sokol92 » Записан

Владимир.
eeigor
Форумчанин
***
Offline Offline

Пол: Мужской
Сообщений: 515



« Ответ #8: 12 Март 2021, 14:39 »

Код не вызывает сомнений. Кроме одного момента: почему константа 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()
Однако, раньше, до обновления, не припомню такого...
« Последнее редактирование: 12 Март 2021, 15:21 от eeigor » Записан

Ubuntu 18.04 LTS • LO 7.1.1.2 Community
ink-service
Участник
**
Offline Offline

Сообщений: 43


« Ответ #9: 14 Март 2021, 22:35 »

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

Как обычно, у А. Питоньяка есть все необходимое.
вот это работает.. спасибо..
НО , макрос  economist - выделял дубликаты разными цветами, и мне это понравилось).
Можно ли в этом коде что-то поправить и получить такой же результат?)
Записан
eeigor
Форумчанин
***
Offline Offline

Пол: Мужской
Сообщений: 515



« Ответ #10: 14 Март 2021, 22:49 »

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

Код:
Sub SetConditionalStyle
    Call SelectData
    <...>
End Sub

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

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

Но вариант от @economist может быть переписан без использования кода VBA.
« Последнее редактирование: 14 Март 2021, 23:04 от eeigor » Записан

Ubuntu 18.04 LTS • LO 7.1.1.2 Community
sokol92
Форумчанин
***
Offline Offline

Пол: Мужской
Сообщений: 381


WWW
« Ответ #11: 15 Март 2021, 12:21 »

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

Владимир.
ink-service
Участник
**
Offline Offline

Сообщений: 43


« Ответ #12: 15 Март 2021, 19:54 »

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

Пол: Мужской
Сообщений: 381


WWW
« Ответ #13: 15 Март 2021, 21:23 »

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

Владимир.
sokol92
Форумчанин
***
Offline Offline

Пол: Мужской
Сообщений: 381


WWW
« Ответ #14: 16 Март 2021, 15:14 »

Попробуйте вариант с "твердой" раскраской дублирующихся значений ячеек. Для раскраски выделенных ячеек можно вызвать 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
Записан

Владимир.
Страниц: 1 2 »   Вверх
  Печать  
 
Перейти в:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2006-2009, Simple Machines Valid XHTML 1.0! Valid CSS!