Замена символов в выделенном фрагменте текста - макрос

[snik100]

Здравствуйте! Требуется замена определенных символов только в выделенном фрагменте текста.
На просторах интернета нашел только такой вариант:

Sub Main
Dim ReplaceDescriptor As Object
Sheet=ThisComponent
ReplaceDescriptor=Sheet.createReplaceDescriptor()
ReplaceDescriptor.SearchRegularExpression=1
ReplaceDescriptor.SearchString = "1"
ReplaceDescriptor.ReplaceString ="2"
Sheet.ReplaceAll(ReplaceDescriptor)
End Sub

На примере цифр 1 и 2, но 1 заменяется на 2 во всем документе, а надо только в выделенном фрагменте.

Изначально мне нужен аналог макроса из microsoft word

Public Sub LAB()
    Dim myRange As Range
    Set myRange = Selection.Range
    myRange.Find.Execute FindText:=" ^0013", ReplaceWith:=", ", Replace:=wdReplaceAll
End Sub

то есть замена пробела и символа возврата каретки на запятую и пробел.
Заранее благодарю!

[eeigor]

Ну так замените ссылку
Sheet на ThisComponent.CurrentSelection

[snik100]

Ну так замените ссылку
Sheet на ThisComponent.CurrentSelection

Спасибо за ответ.
Но тогда возникает ошибка

Ошибка времени выполнения Basic.
Свойство или метод не найдены: createReplaceDescriptor.

[eeigor]

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

[mikekaganski]

Sub Main
Dim ReplaceDescriptor As Object
Sheet=ThisComponent
ReplaceDescriptor=Sheet.createReplaceDescriptor()
ReplaceDescriptor.SearchRegularExpression=1
ReplaceDescriptor.SearchString = "1"
ReplaceDescriptor.ReplaceString ="2"
Sheet.ReplaceAll(ReplaceDescriptor)
End Sub

На примере цифр 1 и 2, но 1 заменяется на 2 во всем документе, а надо только в выделенном фрагменте.

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

Sheet=ThisComponent показывает, что "на просторах интернета" обсуждалась работа с Calc. Ваш вопрос озаглавлен "Замена символов в выделенном фрагменте текста - макрос", и находится в разделе Writer. Поэтому

Ну так замените ссылку
Sheet на ThisComponent.CurrentSelection

и не сработает. У документов Calc объект-диапазон умеет поиск и замену. А у Writer объект-текст, возвращаемый ThisComponent.CurrentSelection, не умеет.

В этой теме на https://ask.libreoffice.org обсуждался этот вопрос. Надо указать флаг "в выделенном фрагменте" (недокументированный!).

[eeigor]

Подождите...

Даже боюсь предположить, сколько бы я самостоятельно искал ответ на вопрос, если бы не Михаил...

dispatcher = createUnoService ("com.sun.star.frame.DispatchHelper")
dim args1 (21) as new com.sun.star.beans.PropertyValue
...
args1 (10) .Name = "SearchItem.SearchFlags"
args1 (10) .Value = 2048
args1 (11) .Name = "SearchItem.SearchString"
args1 (11). Value = "structure"
...
dispatcher.executeDispatch (document, ".uno: ExecuteSearch", "", 0, args1 ())

[snik100]

Извините, но почти ничего не понял)
Подскажите, пожалуйста, конечный результат каким должен быть?

[eeigor]

Если через диспетчер, то записано так...

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

Sub ReplaceAllInSelection()
Dim document As Object, dispatcher As Object
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

Dim args(21) As New com.sun.star.beans.PropertyValue
args(0).Name = "SearchItem.StyleFamily"
args(0).Value = 2
args(1).Name = "SearchItem.CellType"
args(1).Value = 0
args(2).Name = "SearchItem.RowDirection"
args(2).Value = True
args(3).Name = "SearchItem.AllTables"
args(3).Value = False
args(4).Name = "SearchItem.SearchFiltered"
args(4).Value = False
args(5).Name = "SearchItem.Backward"
args(5).Value = False
args(6).Name = "SearchItem.Pattern"
args(6).Value = False
args(7).Name = "SearchItem.Content"
args(7).Value = False
args(8).Name = "SearchItem.AsianOptions"
args(8).Value = False
args(9).Name = "SearchItem.AlgorithmType"
args(9).Value = 0
args(10).Name = "SearchItem.SearchFlags"
args(10).Value = 71680

args(11).Name = "SearchItem.SearchString"
args(11).Value = "1"
args(12).Name = "SearchItem.ReplaceString"
args(12).Value = "2"

args(13).Name = "SearchItem.Locale"
args(13).Value = 255
args(14).Name = "SearchItem.ChangedChars"
args(14).Value = 2
args(15).Name = "SearchItem.DeletedChars"
args(15).Value = 2
args(16).Name = "SearchItem.InsertedChars"
args(16).Value = 2
args(17).Name = "SearchItem.TransliterateFlags"
args(17).Value = 1073743104
args(18).Name = "SearchItem.Command"
args(18).Value = 3
args(19).Name = "SearchItem.SearchFormatted"
args(19).Value = False
args(20).Name = "SearchItem.AlgorithmType2"
args(20).Value = 1
args(21).Name = "Quiet"
args(21).Value = True

dispatcher.executeDispatch(document, ".uno:ExecuteSearch", "", 0, args())
End Sub
Вопросы не только у Вас, но и у меня не меньше...
Что касается значения флага 71680, то в "документации" сказано:
2048 -> search only the selected cells

[sokol92]

Михаил, большое спасибо!
Как Ваше экспертное мнение, насколько можно "доверять" ссылке (этой и другим) данного автора?

[mikekaganski]

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

[sokol92]

опипастить его тексты в систему жизнеобеспечения

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

[eeigor]

Подскажите, пожалуйста, конечный результат каким должен быть?

Вот так попроще будет...

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

Sub ReplaceAllInSelectionUsingCharFlash(sSearch$, sReplace$, Optional SearchRegularExpression)
Dim oDoc As Object, oSels As Object
Dim aSearchAttribs(0) As New com.sun.star.beans.PropertyValue
Dim oSearchDsc As Object
Dim i%

Dim nAlgorithmType2%  '1=ABSOLUTE|2=REGEXP|3=APPROXIMATE|4=WILDCARD
nAlgorithmType2 = com.sun.star.util.SearchAlgorithms2.ABSOLUTE

If IsMissing(SearchRegularExpression) Then SearchRegularExpression = False
If SearchRegularExpression Then
nAlgorithmType2 = com.sun.star.util.SearchAlgorithms2.REGEXP
End If

oDoc = ThisComponent
oSels = oDoc.CurrentController.Selection
For i = 0 To oSels.Count - 1
oSels(i).CharFlash = True
Next

oSearchDsc = oDoc.createSearchDescriptor()
With oSearchDsc
.SearchString = sSearch
.ReplaceString = sReplace
.SearchRegularExpression = SearchRegularExpression
aSearchAttribs(0).Name = "CharFlash"  'if True, then the characters are flashing
aSearchAttribs(0).Value = True
.setSearchAttributes(aSearchAttribs)
End With

oDoc.replaceAll(oSearchDsc)

For i = 0 To oSels.Count - 1
oSels(i).CharFlash = False
Next
End Sub

Sub TestReplaceAllInSelectionUsingCharFlash()
Call ReplaceAllInSelectionUsingCharFlash("$", ", ", True)
End Sub

Надо заметить, что решение содержит некий трюк: выделенным текстовым диапазонам oSels присваивается значение свойства <CharFlash = True>, и они начинают мигать (flashing), что позволяет их "захватить" дескриптором поиска через атрибут CharFlash. Вполне удобоваримо. Во всяком случае просто.
При подготовке решения использован материал по ссылке.

UPDATED:
Процедура обновлена с учётом использования регулярных выражений.

[mikekaganski]

   For i = 0 To oSels.Count - 1
      oSels(i).CharFlash = True
   Next

   ...

   For i = 0 To oSels.Count - 1
      oSels(i).CharFlash = False
   Next

создаёт прямое форматирование.

[eeigor]

создаёт прямое форматирование

Да. А есть другие предложения? UNO-метод из ответа #7 выглядит чересчур туманным и перегруженным.

[eeigor]

@sokol92, мы ведь производим замену, и, полагаю, это непринципиально.
Ну, а где Ваши предложения?