Тема: Макрос для замены на степень
Добрый день.
Нужен макрос для замены следующих выражений
м2, М2, м3, М3, дм3 и ДМ3
на аналогичные, но цифры должны быть верхним индексом.
Нужно чтобы работало на выделенном тексте.
Re: Макрос для замены на степень
Сделал макрос, но плохо отрабатывает на выделенном тексте (преобразовывает и за выделением до конца документа). Подскажите что не так.
Sub Test()
Set rng = Selection.Range
With rng.Find
.MatchWildcards = True
.Text = "м[23]{1}"
.MatchCase = False
While .Execute
rng.Characters.Last.Font.Superscript = True
Wend
End With
End Sub
Re: Макрос для замены на степень
tna пишет:
Добрый день.
Нужен макрос для замены следующих выражений
м2, М2, м3, М3, дм3 и ДМ3
на аналогичные, но цифры должны быть верхним индексом.Нужно чтобы работало на выделенном тексте.
Мой вариант
Sub MeterValuesToSuperscript()
Dim selrg As Range
Dim charrg As Range
Dim scharrg As Range
Dim srl As Long
Dim isrl As Long
Dim scharrgtext As String
Dim selrgstart As Long
Dim selrgend As Long
Set selrg = Selection.Range
selrgstart = selrg.Start
selrgend = selrg.End
If selrgend - selrgstart = 0 Then
MsgBox "Text is not selected"
Else
Set charrg = selrg
Set scharrg = selrg
srl = Len(selrg.Text)
For isrl = 1 To srl
charrg.SetRange Start:=selrgstart + isrl - 1, End:=selrgstart + isrl
If (LCase$(charrg.Text) = "ì") And (isrl < srl) Then
scharrg.SetRange Start:=charrg.Start + 1, End:=charrg.Start + 2
scharrgtext = scharrg.Text
If (scharrgtext = "2") Or (scharrgtext = "3") Then
scharrg.Font.Superscript = True
End If
End If
Next isrl
End If
Set selrg = Nothing
End SubRe: Макрос для замены на степень
yshindin пишет:
Мой вариант
Прошу прощения, при вставке текста исказилась буква "м".
Правильный вариант
. . .
If (LCase$(charrg.Text) = "м") And (isrl < srl) Then
. . .Re: Макрос для замены на степень
yshindin спасибо то что надо!
А можно его подправить чтобы мг/л переводил в мг/дм3 (3 - верхний индекс)
Re: Макрос для замены на степень
tna пишет:
А можно его подправить чтобы мг/л переводил в мг/дм3 (3 - верхний индекс)
А вы сначала обычной заменой замените "мг/л" на "мг/дм3" (3 - обычная цифра), а потом приведенным мной макросом "дм3" на "дм3" (3 - верхний индекс)
o_O))
Re: Макрос для замены на степень
Ну это да )). 2-я макросами я это делаю.
А в один ни как?
Re: Макрос для замены на степень
tna пишет:
Ну это да )). 2-я макросами я это делаю.
А в один ни как?
Можно, только придется код переписывать (и он будет немного сложнее).
Вы запишите на макрорекордере VBA код обычной замены "мг/л" на "мг/дм3" (3 - обычная цифра) и вставьте сгенерированный код до исполнения кода макроса замены "дм3" на "дм3" (3 - верхний индекс).
Можно и так: создайте отдельную процедуру, из которой вызывайте записанный на макрорекордере макрос обычной замены и затем макрос, предложенный мной.
Re: Макрос для замены на степень
Для полноты картины посмотрите еще эту тему из блога Антона Кокина:
http://wordexpert.ru/page/makros-zameny … m-registre
Re: Макрос для замены на степень
Boris_R спасибо, это видел (
Там решение - меняют на символ из таблицы, а мне нужно на верхний индекс.
Решение найдено, но в 2 этапа:
1.Макрос замены на мг/л на мг/дм3
2. А потом с помощью макроса yshindin ставится верхний индекс.
Объединить макросы не получилось (
После выполнения перового, второй макрос пишет нет выделения ((.
Можно ли вернуть выделение, какой нибудь процедурой по новому?
Если кто решит вопрос буду признателен.
Re: Макрос для замены на степень
tna пишет:
. . .
Можно ли вернуть выделение, какой нибудь процедурой по новому?
. . .
Да, можно. Для этого надо перед выполнением процедуры "запомнить" границы выделения, а после выполнения - восстановить. Это можно сделать путем запоминания границ диапазона выделения (Selection.Range.Start и Selection.Range.End), но такой метод не очень надежен, т.к. в ходе выполнения процедуры в пределах запомненного диапазона могут быть выполнены операции добавления, либо удаления текста, и тогда после восстановления выделения по запомненным границам выяснится, что границы "съехали". Более надежный прием - запоминание диапазона во временную закладку, а затем восстановление выделения по закладке. Word синхронно поддерживает границы всех закладок: если внутренний текст документа где-либо меняется (в том числе внутри любой закладки), то диапазоны всех закладок автоматически перестраиваются.
Я подготовил пример запоминания и восстановления закладки. В стартовой процедуре t_SSR вызывается сначала подпрограмма StoreSelectionRange, которая запоминает границы текущего выделения во временную закладку temp_bmk. Затем вызывается процедура GotoStart, которая меняет Selection (в процедуре выполняется переход к началу документа). Далее в примере вызывается процедура восстановления запомненного ранее выделения RestoreSelectionByBookmark.
Sub t_SSR()
'Saving the selection by bookmark
StoreSelectionRange "temp_bmk"
'Calling macro that changes the selection
GotoStart
'Restoring the selection by bookmark
RestoreSelectionByBookmark "temp_bmk"
'Calling another macro
'. . .
End Sub
Sub StoreSelectionRange(bmkname As String)
If ActiveDocument.Bookmarks.Exists(bmkname) = True Then
ActiveDocument.Bookmarks(bmkname).Delete
End If
ActiveDocument.Bookmarks.add bmkname, Selection.range
End Sub
Sub RestoreSelectionByBookmark(bmkname As String)
If ActiveDocument.Bookmarks.Exists(bmkname) = True Then
Selection.GoTo What:=wdGoToBookmark, name:=bmkname
End If
End Sub
Sub GotoStart()
Selection.GoTo What:=wdGoToLine, Which:=wdGoToFirst
End Sub