Поиск и выделение текста цветом

Автор dd4, 16 марта 2019, 04:36

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

dd4

Добрый день.
Как реализовать следующее: в документе LO Writer (.docx) в тексте найти определенные слова и выделить их цветом, например, красным. Т.е. открыл документ, нажал кнопку, произведен поиск и нужные слова выделены (слов может быть несколько)? В калькуляторе такое можно реализовать через условное форматирование, а вот в Writer у меня не получается.
Спасибо.

JohnSUN

Записать макрорекордером?
Sub setColorToWords
Dim document As Object, dispatcher As Object
Dim sWord As String
Dim args1(21) As New com.sun.star.beans.PropertyValue
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
sWord = InputBox("Какое слово закрасить?","Красный шрифт")
args1(0).Name = "SearchItem.StyleFamily" : args1(0).Value = 2
args1(1).Name = "SearchItem.CellType" : args1(1).Value = 0
args1(2).Name = "SearchItem.RowDirection" : args1(2).Value = true
args1(3).Name = "SearchItem.AllTables" : args1(3).Value = false
args1(4).Name = "SearchItem.SearchFiltered" : args1(4).Value = false
args1(5).Name = "SearchItem.Backward" : args1(5).Value = false
args1(6).Name = "SearchItem.Pattern" : args1(6).Value = false
args1(7).Name = "SearchItem.Content" : args1(7).Value = false
args1(8).Name = "SearchItem.AsianOptions" : args1(8).Value = false
args1(9).Name = "SearchItem.AlgorithmType" : args1(9).Value = 1
args1(10).Name = "SearchItem.SearchFlags" : args1(10).Value = 65536
args1(11).Name = "SearchItem.SearchString" : args1(11).Value = sWord
args1(12).Name = "SearchItem.ReplaceString" : args1(12).Value = "&"
args1(13).Name = "SearchItem.Locale" : args1(13).Value = 255
args1(14).Name = "SearchItem.ChangedChars" : args1(14).Value = 2
args1(15).Name = "SearchItem.DeletedChars" : args1(15).Value = 2
args1(16).Name = "SearchItem.InsertedChars" : args1(16).Value = 2
args1(17).Name = "SearchItem.TransliterateFlags" : args1(17).Value = 1073743104
args1(18).Name = "SearchItem.Command" : args1(18).Value = 3
args1(19).Name = "SearchItem.SearchFormatted" : args1(19).Value = false
args1(20).Name = "SearchItem.AlgorithmType2" : args1(20).Value = 2
args1(21).Name = "Quiet" : args1(21).Value = true

dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args1())
End Sub
Владислав Орлов aka JohnSUN
Благодарить-не зазорно.
Подарить благо создателям офиса, нашему ресурсу, мне

dd4

Спасибо за быстрый ответ.
Макрос работает частично: предлагает выбрать слово, которое необходимо закрасить, но само закрашивание не происходит.
Вот что бывает, если не совсем точно изложить суть проблемы.
Мне надо, чтобы был произведен поиск определенных слов и дальнейшее выделение цветом таких слов. Т.е. для работа макроса чтобы не надо было каждый раз вводить слово/слова.
Я прилагаю документ (скачан из открытых источников), на примере которого вот что мне надо находить (и в других документах) и менять цвет: рішенн, справ, наказ, виконавч, лист, реєстр, провадж (слова указаны без окончаний специально).
Можно ли такие слова для поиска уже сразу внести в макрос? И моно кроме выделения цветом добавить выделение "жирным"? (мне надо, чтобы эти найденные слова бросались в глаза).
Спасибо.

JohnSUN

#3
Цитата: dd4 от 16 марта 2019, 11:15
Макрос работает частично: предлагает выбрать слово, которое необходимо закрасить, но само закрашивание не происходит.
Странно... У меня меняет шрифт на красный. Ладно, сейчас посмотрим, что можно сделать по уточнённой задаче.
Цитата: dd4 от 16 марта 2019, 11:15
мне надо, чтобы эти найденные слова бросались в глаза
Это понятно, что "чтобы бросались в глаза" - скажи зачем? Быстрое редактирование по отмеченным местам, а потом вернуться к обычному формату? Или оно навсегда останется раскрашенным? Или это просто для сортировки документов по типам, чтобы разложить в разные папки?

Upd.Протестируй-ка вот это:
Sub FindAndColor()
Const STYLE_NAME = "Броситься_в_глаз" ' Назови как хочешь, лишь бы не повторять стандартное имя стиля
Const WORDS = "рішенн, справ, наказ, виконавч, лист, реєстр, провадж" ' Сюда полный перечень слов для раскраски
Dim oStyleFamilies As Variant, oCharStyles As Variant, oNewStyle As Variant, sParentStyleName As String
Dim aDictionary As Variant, SearchDescriptor As Variant
Dim i As Long, j As Long
oStyleFamilies = ThisComponent.getStyleFamilies()
oCharStyles = oStyleFamilies.getByName("CharacterStyles")
If Not oCharStyles.hasByName(STYLE_NAME) Then
oNewStyle = oCharStyles.getByIndex(0)
sParentStyleName = oNewStyle.getName()
oNewStyle = ThisComponent.createInstance("com.sun.star.style.CharacterStyle")
oNewStyle.ParentStyle = sParentStyleName
oCharStyles.insertByName(STYLE_NAME, oNewStyle)
Rem Здесь устанавливаешь разные цвета-жирности-размеры шрифта
oNewStyle.setPropertyValue("CharBackColor", RGB(0,255,0))
oNewStyle.setPropertyValue("CharColor", RGB(255,0,0))
oNewStyle.setPropertyValue("CharWeight", 150)
oNewStyle.setPropertyValue("CharHeight", oNewStyle.getPropertyValue("CharHeight")*2)
EndIf
Rem Список слов разбить на отдельные слова
aDictionary = Split(WORDS, ",")
For i = LBound(aDictionary) To UBound(aDictionary)
SearchDescriptor = ThisComponent.createSearchDescriptor()
SearchDescriptor.SearchAll = True
SearchDescriptor.SearchRegularExpression = True
SearchDescriptor.setSearchString("[^ ,\.;:]*" & Trim(aDictionary(i)) & "[^ ,\.;:]*")
oFound = ThisComponent.findAll(SearchDescriptor)
Rem Для каждого найденного слова применить наш стиль
For j = 0 To oFound.getCount()-1
oFound.getByIndex(j).CharStyleName = STYLE_NAME
Next j
Next i
End Sub
Владислав Орлов aka JohnSUN
Благодарить-не зазорно.
Подарить благо создателям офиса, нашему ресурсу, мне

dd4

#4
то понятно, что "чтобы бросались в глаза" - скажи зачем?
Вы видели текст документа - в нем мне надо находить для себя ключевые моменты. Ничего сортировать мне не надо. Суть: открыл документ, нажал кнопку, - увидел ключевые слова. Оно навсегда останется раскрашенным. К обычному формату возвращаться мне не надо.

Все работает. Спасибо Вам.

dd4

Подскажите, а как сделать такой же макрос но для LO Calc?
Т.е. чтобы искал слова и выделял ячейку, где есть искомое слово.
Спасибо

rami

Цитата: dd4 от 18 апреля 2019, 12:48Подскажите, а как сделать такой же макрос но для LO Calc?
Т.е. чтобы искал слова и выделял ячейку, где есть искомое слово.
Почти так же, с небольшими поправками:
Sub FindAndColorCalc()    'для таблиц Calc
Const STYLE_NAME = "Броситься_в_глаз" ' Назови как хочешь, лишь бы не повторять стандартное имя стиля
Const WORDS = "рішенн, справ, наказ, виконавч, лист, реєстр, провадж" ' Сюда полный перечень слов для раскраски
Dim oStyleFamilies As Variant, oCharStyles As Variant, oNewStyle As Variant, sParentStyleName As String
Dim aDictionary As Variant, SearchDescriptor As Variant
Dim i As Long, j As Long
oSheet = ThisComponent.Sheets(0)
oStyleFamilies = ThisComponent.getStyleFamilies()
oCharStyles = oStyleFamilies.getByName("CellStyles")
If Not oCharStyles.hasByName(STYLE_NAME) Then
oNewStyle = oCharStyles.getByIndex(0)
sParentStyleName = oNewStyle.getName()
oNewStyle = ThisComponent.createInstance("com.sun.star.style.CellStyle")
oNewStyle.ParentStyle = sParentStyleName
oCharStyles.insertByName(STYLE_NAME, oNewStyle)
Rem Здесь устанавливаешь разные цвета-жирности-размеры шрифта
oNewStyle.setPropertyValue("CellBackColor", RGB(0,255,0))
oNewStyle.setPropertyValue("CharColor", RGB(255,0,0))
oNewStyle.setPropertyValue("CharWeight", 150)
oNewStyle.setPropertyValue("CharHeight", oNewStyle.getPropertyValue("CharHeight")*2)
EndIf
Rem Список слов разбить на отдельные слова
aDictionary = Split(WORDS, ",")
For i = LBound(aDictionary) To UBound(aDictionary)
SearchDescriptor = oSheet.createSearchDescriptor()
SearchDescriptor.SearchRegularExpression = True
SearchDescriptor.setSearchString("[^ ,\.;:]*" & Trim(aDictionary(i)) & "[^ ,\.;:]*")
oFound = oSheet.findAll(SearchDescriptor)
Rem Для каждого найденного слова применить наш стиль
For j = 0 To oFound.getCount()-1
oFound.getByIndex(j).CellStyle = STYLE_NAME
Next j
Next i
End Sub

dd4

Подскажите, пожалуйста, что надо изменить в макросе для ЛОКальк, чтобы не изменялся размер найденных слов?
oNewStyle.setPropertyValue("CellBackColor", RGB(0,255,0)) и оNewStyle.setPropertyValue("CharColor", RGB(255,0,0)) - отвечают за выделением цвета
oNewStyle.setPropertyValue("CharWeight", 150) - выделение жирным цветом
oNewStyle.setPropertyValue("CharHeight", oNewStyle.getPropertyValue("CharHeight")*2) - вот это скорее всего отвечает за размер шрифта, но не могу его отредактировать - не хватает знаний
спасибо

dd4

и вот еще такая ошибка выскакивает

bigor

Цитата: dd4 от 21 апреля 2019, 10:23чтобы не изменялся размер найденных слов?
закомментировать/удалить строку oNewStyle.setPropertyValue("CharHeight", oNewStyle.getPropertyValue("CharHeight")*2)
после этого удалить в документе стиль "Броситься_в_глаз"

по поводу ошибки, у меня возникает если слова из перечня нет на листе. Как лечить пока не разбирался
Поддержать разработчиков LibreOffice можно можно тут, а наш форум вот тут

rami

Пробуйте:
Sub FindAndColorCalc()    'для таблиц Calc
Const STYLE_NAME = "Броситься_в_глаз" ' Назови как хочешь, лишь бы не повторять стандартное имя стиля
Const WORDS = "рішенн, справ, наказ, виконавч, лист, реєстр, провадж" ' Сюда полный перечень слов для раскраски
Dim oStyleFamilies As Variant, oCharStyles As Variant, oNewStyle As Variant, sParentStyleName As String
Dim aDictionary As Variant, SearchDescriptor As Variant
Dim i As Long, j As Long
oSheet = ThisComponent.Sheets(0)
oStyleFamilies = ThisComponent.getStyleFamilies()
oCharStyles = oStyleFamilies.getByName("CellStyles")
If Not oCharStyles.hasByName(STYLE_NAME) Then
oNewStyle = oCharStyles.getByIndex(0)
sParentStyleName = oNewStyle.getName()
oNewStyle = ThisComponent.createInstance("com.sun.star.style.CellStyle")
oNewStyle.ParentStyle = sParentStyleName
oCharStyles.insertByName(STYLE_NAME, oNewStyle)
Rem Здесь устанавливаешь разные цвета-жирности-размеры шрифта
oNewStyle.setPropertyValue("CellBackColor", RGB(0,255,0))
oNewStyle.setPropertyValue("CharColor", RGB(255,0,0))
oNewStyle.setPropertyValue("CharWeight", 150)
EndIf
Rem Список слов разбить на отдельные слова
aDictionary = Split(WORDS, ",")
For i = LBound(aDictionary) To UBound(aDictionary)
SearchDescriptor = oSheet.createSearchDescriptor()
SearchDescriptor.SearchRegularExpression = True
SearchDescriptor.setSearchString("[^ ,\.;:]*" & Trim(aDictionary(i)) & "[^ ,\.;:]*")
oFound = oSheet.findAll(SearchDescriptor)
Rem Для каждого найденного слова применить наш стиль
If Not isNull(oFound) Then 'если найденое не Null — выполняем, иначе пропускаем
For j = 0 To oFound.getCount()-1
oFound.getByIndex(j).CellStyle = STYLE_NAME
Next j
EndIf
Next i
End Sub

dd4

Цитата: Bigor от 21 апреля 2019, 11:21по поводу ошибки, у меня возникает если слова из перечня нет на листе.
у меня такая ошибка, даже если и слова искомые есть на странице
такое впечатление, что я что-то с макросами накрутил

dd4

вот сам файл, может так проще будет

rami

Вы видели в макросе строку кода:
Const WORDS = "рішенн, справ, наказ, виконавч, лист, реєстр, провадж" ' Сюда полный перечень слов для раскраски
в вашем последнем файле есть хоть одно из этих слов: рішенн, справ, наказ, виконавч, лист, реєстр, провадж? Если есть, скажите мне в какой ячейке, если нет, замените указанные слова на те, что вам нужно найти.

bigor

У меня находит 3 вхождения. Правда надо лист 3 указать.
dd4 удалите стиль "Броситься_в_глаз"
Поддержать разработчиков LibreOffice можно можно тут, а наш форум вот тут