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

[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

[dd4]

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

[JohnSUN]

Макрос работает частично: предлагает выбрать слово, которое необходимо закрасить, но само закрашивание не происходит.

Странно... У меня меняет шрифт на красный. Ладно, сейчас посмотрим, что можно сделать по уточнённой задаче.

мне надо, чтобы эти найденные слова бросались в глаза

Это понятно, что "чтобы бросались в глаза" - скажи зачем? Быстрое редактирование по отмеченным местам, а потом вернуться к обычному формату? Или оно навсегда останется раскрашенным? Или это просто для сортировки документов по типам, чтобы разложить в разные папки?

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


[dd4]

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

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

[dd4]

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

[rami]

Подскажите, а как сделать такой же макрос но для 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]

чтобы не изменялся размер найденных слов?

закомментировать/удалить строку

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

oNewStyle.setPropertyValue("CharHeight", oNewStyle.getPropertyValue("CharHeight")*2)
после этого удалить в документе стиль "Броситься_в_глаз"

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

[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]

по поводу ошибки, у меня возникает если слова из перечня нет на листе.

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

[dd4]

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

[rami]

Вы видели в макросе строку кода:

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

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

[bigor]

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