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

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

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

Войти
Новости: Часто задаваемые вопросы по LibreOffice и Apache OpenOffice.org
 
   Начало   Помощь Поиск Войти Регистрация    задать вопрос  
Страниц: « 1 2 3 »   Вниз
  Печать  
Автор Тема: Выделение определенного слова, состояние ячеек  (Прочитано 1423 раз)
0 Пользователей и 2 Гостей смотрят эту тему.
sokol92
Форумчанин
***
Online Online

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


WWW
« Ответ #57176: 22 Январь 2021, 16:48 »

Можно так. Пример использования в макросе TestRangeTextsColor.

Код:
Option Compatible
' Раскрашивает различными цветами фрагменты текстов в ячейке.
' - oCell ячейка.
' - aTexts массив фрагментов текстов.
' - entireWords Если True, то раскрашивать только целые слова, иначе фрагменты.
' - aColors массив цветов (той же размерности, что aTexts).
' - matchCase False:происводить поиск слов без учета регистра букв, True - с учетом регистра.
'
Sub CellTextsColor(ByVal oCell, ByVal aTexts, ByVal aColors, Optional Byval entireWords as Boolean, Optional ByVal matchCase As Boolean)
  Dim oTextCursor, i As Long, j as Long, j0 as Long, i0 as String, s As String, bFound As Boolean
 
  If IsMissing(matchCase) Then matchCase=False
  If IsMissing(entireWords) Then entireWords=False
 
  oTextCursor=oCell.createTextCursor()
  s=oCell.String
 
  For i=LBound(aTexts) To UBound(aTexts)
    j0=1
    Do While j0<=len(s)
      If matchCase Then
        j=Instr(j0, s, aTexts(i), 0)
      Else
        j=Instr(j0, lcase(s), lcase(aTexts(i)), 0) 
      End If
       
      If j>0 Then
        bFound=True
        If entireWords Then
          If j>1 Then 
            If Ucase(Mid(s, j-1, 1))<>lCase(Mid(s, j-1, 1)) Then bFound=False   ' слева от найденного текста - буква
          End If
          If j+Len(aTexts(i))<=Len(s) Then 
            If Ucase(Mid(s, j+Len(aTexts(i)), 1))<>lCase(Mid(s, j+Len(aTexts(i)), 1)) Then bFound=False   ' справа от найденного текста - буква
          End If
        End If
        If bFound Then
          With oTextCursor
            .gotoStart False
            .goRight j-1 , False 
            .goRight Len(aTexts(i)), True
            .CharColor=aColors(i)
          End With 
        End If
      Else
        Exit Do
      End If
     
      j0=j+Len(aTexts(i))
    Loop
  Next i
End Sub

' Раскрашивает различными цветами фрагменты текстов в диапазоне(диапазонах) ячеек.
' - oRange ячейка или диапазон ячеек
' - aTexts массив фрагментов текстов.
' - entireWords Если True, то раскрашивать только целые слова, иначе фрагменты.
' - aColors массив цветов (той же размерности, что aTexts).
' - matchCase False:происводить поиск слов без учета регистра букв, True - с учетом регистра.
'
Sub RangeTextsColor(ByVal oRange, ByVal aTexts, ByVal aColors, Optional Byval entireWords as Boolean, Optional ByVal matchCase As Boolean)
  Dim oCell
  If IsMissing(matchCase) Then matchCase=False
  If IsMissing(entireWords) Then entireWords=False
 
  If oRange.supportsService("com.sun.star.sheet.SheetCell") Then
    CellTextsColor oRange, aTexts, aColors, entireWords, matchCase
  Else
    For Each oCell In oRange.queryContentCells(com.sun.star.sheet.CellFlags.STRING).getCells
      CellTextsColor oCell, aTexts, aColors, entireWords, matchCase
    Next oCell 
  End If
End Sub

' Раскрашивает в выделенном фрагменте ячеек слова "все", "очень", "сложно".
Sub TestRangeTextsColor
   RangeTextsColor ThisComponent.CurrentSelection, Array("все", "очень", "сложно"), Array(RGB(255, 0, 0), RGB(0, 255, 0), RGB(0, 0, 255)),False
End Sub

« Последнее редактирование: 23 Январь 2021, 16:04 от sokol92 » Записан

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

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