1

Тема: Что не так с макросом

Извиняюсь за простейший вопрос для разбирающихся. В общем раньше, когда училась, частенько приходилось переделывать интернетовские курсовые для себя, тогда я вбила макрос для обработки - просто записала действия в найти и заменить (там пробелы убрать после скобок, двойные пробелы убрать, после цифр неразрываемые поставлять и т.д., кучу всего повнесла), все работало прекрасно, кучу времени мне сэкономило. Это я про то, что я в макросах и скриптах ни бум-бум, просто записала все действия через найти и заменить, а в бэйсик (не знаю даже, как правильно приложение называется, которое открывается при "изменить макрос") даже не совалась.
А вчера вот попыталась записать элементарные два действия так же, и никак не хочет работать. Час точно просидела, пытаясь в изменить подправить, но т.к. знаний 0, то без толку.
В общем, с вашего же сайта:
заменить м2, м3 на чтобы цифры надстрочные были.

Действие первое -

Найти: (м)([2,3])
Заменить: \1&$&$\2

Действие второе -

Найти: (&$&$)([2,3])
Заменить: \2 Формат шрифта: Надстрочный

Получается у меня такой макрос, что с ним не так, подскажите, люди smile.

Sub Макрос5()
'
' Макрос5 Макрос
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "(м)([2,3])"
        .Replacement.Text = "\1&$&$\2"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "(&$&$)([2,3])"
        .Replacement.Text = "\2"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

2

Re: Что не так с макросом

1-я часть Вашего макроса работает правильно.
2-я часть в поле Найти выражение (&$&$) воспринимается как службные символы Подстановочных знаков. И не может в тексте найти текстовое выражение &$&$.
Вообще если выборочно я бы посоветовал использовать для обозначения не символы, а цвета. Например:
Действие первое -

Найти: (м)([2,3])
Заменить: Цвет: Оранжевый

Действие второе -

Найти: ([2,3]) Цвет: Оранжевый
Заменить: \2 Формат шрифта: Надстрочный

Действие третье -

Найти: Цвет: Оранжевый
Заменить: Цвет: Авто

Попробуйте записать макрос по этим параметрам. Третье действе сбрасывает по всему тексту выделение Оранжевым.

3

Re: Что не так с макросом

Да, получилось вот так. Хотя не очень я поняла, зачем цвет здесь. Наверное, можно все это дело упростить как-то.

Sub Макрос2()
'
' Макрос2 Макрос
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Highlight = True
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Options.DefaultHighlightColorIndex = wdYellow
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Highlight = True
    With Selection.Find
        .Text = "(м)([2,3])"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Highlight = True
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Highlight = True
    With Selection.Find.Replacement.Font
        .Superscript = True
        .Subscript = False
    End With
    With Selection.Find
        .Text = "([2,3])"
        .Replacement.Text = "\1"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Highlight = True
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Highlight = True
    With Selection.Find
        .Text = "([2,3])"
        .Replacement.Text = "\1"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Options.DefaultHighlightColorIndex = wdNoHighlight
    Selection.Find.ClearFormatting
    Selection.Find.Highlight = True
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Highlight = True
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    ActiveWindow.ActivePane.VerticalPercentScrolled = 0
End Sub

4

Re: Что не так с макросом

Вот, чуть покороче. Не подскажете, какие тут ненужные строки еще можно поудалять?

Sub Макрос2()
'
' Макрос2 Макрос
'
'
    Options.DefaultHighlightColorIndex = wdYellow
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Highlight = True
    With Selection.Find
        .Text = "(м)([2,3])"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Highlight = True
    Selection.Find.Replacement.Highlight = True
    With Selection.Find.Replacement.Font
        .Superscript = True
        .Subscript = False
    End With
    With Selection.Find
        .Text = "([2,3])"
        .Replacement.Text = "\1"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Highlight = True
    Selection.Find.Replacement.Highlight = True
    With Selection.Find
        .Text = "([2,3])"
        .Replacement.Text = "\1"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Options.DefaultHighlightColorIndex = wdNoHighlight
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Highlight = True
    Selection.Find.Replacement.Highlight = True
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    ActiveWindow.ActivePane.VerticalPercentScrolled = 0
End Sub

5

Re: Что не так с макросом

Вы немного не так сделали, но это из-за отсутствия опыта. Вот так должен выглядеть макрос:

Sub Макрос2()
'
' Макрос2 Макрос
'
'
' Находим нужное выражение и выделяем знаки цветом wdDarkRed (темно-красный)
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.ColorIndex = wdDarkRed
    With Selection.Find
        .Text = "(м)([2,3])"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
' Находим выделенные wdDarkRed цветом цифры и заменяем на надстрочные
    Selection.Find.ClearFormatting
    Selection.Find.Font.ColorIndex = wdDarkRed
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Superscript = True
        .Subscript = False
    End With
    With Selection.Find
        .Text = "([2,3])"
        .Replacement.Text = "\1"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
' Находим выделенные wdDarkRed цветом все знаки и возвращаем цвет wdAuto
    Selection.Find.ClearFormatting
    Selection.Find.Font.ColorIndex = wdDarkRed
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.ColorIndex = wdAuto
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

1. Ошибка Ваша в том, что вместо цвета знаков Вы и использовали цвет выделения.
2. Желательно вместо цвета wdDarkRed использовать цвет RGB. Для этого откройте окно Цвета символов и выберете цвет, который, по Вашему мнению никогда не будет использоваться в документах. Значения цвета RGB отображаются, соответственно в полях R, G, B. После этого замените в макросе все строки Selection.Find.Font.ColorIndex = wdDarkRed на Selection.Find.Font.Color = RGB(R, G, B). Также заменить Selection.Find.Replacement.Font.ColorIndex = wdDarkRed на Selection.Find.Replacement.Font.Color = RGB(R, G, B).
3. Макрос мало функционален, т.к. заменяет узкое количество заранее определенных выражений. Его можно унифицировать и с небольшими изменениями на много расширить его действие. Как это сделать укажу в следующем посте.

6

Re: Что не так с макросом

Вот модифицированный макрос:

Sub Макрос2()
'
' Макрос2 Макрос
'
Dim s As Variant
   
    
    inp = InputBox("Разделитель между словами знак «;;»!!!" & Chr(13) _
                & "Например: (м);;([2;3])!!!" & Chr(13) _
                & "Введите выражение:")
    s = Split(inp, ";;")
    inp = s(0) & s(1)

' Находим нужное выражение и выделяем знаки цветом wdDarkRed (темно-красный)
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.ColorIndex = wdDarkRed
    With Selection.Find
        .Text = inp
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
' Находим выделенные wdDarkRed цветом цифры и заменяем на надстрочные
    Selection.Find.ClearFormatting
    Selection.Find.Font.ColorIndex = wdDarkRed
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Superscript = True
        .Subscript = False
    End With
    With Selection.Find
        .Text = s(1)
        .Replacement.Text = "\1"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
' Находим выделенные wdDarkRed цветом все знаки и возвращаем цвет wdAuto
    Selection.Find.ClearFormatting
    Selection.Find.Font.ColorIndex = wdDarkRed
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.ColorIndex = wdAuto
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Пример работы:
1. Имеем в документе выражения: m3, f45, ю96.
2. Запускаем макрос.
3. В окне запроса набираем: ([m, f, ю]);;([0-9]{1;}).
Важно!!! Между выражений в скобках обязательно поставить «;;».
4. Жмем OK.

Пример работы:
1. Заменить все латинские буквы с цифрами на надстрочные.
2. Запускаем макрос.
3. В окне запроса набираем: ([a-z]);;([0-9]{1;}).
Важно!!! Между выражений в скобках обязательно поставить «;;».
4. Жмем OK.

7

Re: Что не так с макросом

Для подстрочных знаков в макросе нужно заменить:

With Selection.Find.Replacement.Font
        .Superscript = True
        .Subscript = False
End With

на

With Selection.Find.Replacement.Font
        .Superscript = False
        .Subscript = True
End With

8

Re: Что не так с макросом

Спасибо большое.)

9

Re: Что не так с макросом

Я извиняюсь, не в тему напишу, не подскажете что бы почитать для приобретения опыта этого самого? Может конкретный самоучитель?

10

Re: Что не так с макросом

Вот полностью 2 макроса для замены на надстрочные и подстрочные знаки:

Public Sub Надстрочные()
Dim s As Variant
   
    
    inp = InputBox("Разделитель между словами знак «;;»!!!" & Chr(13) _
                & "Например: (м);;([2;3])!!!" & Chr(13) _
                & "Введите выражение:", "2-е выражение НАДСТРОЧНЫЕ")
    s = Split(inp, ";;")
    inp = s(0) & s(1)

' Находим нужное выражение и выделяем знаки цветом RGB(77, 245, 253)
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Color = RGB(77, 245, 253)
    With Selection.Find
        .Text = inp
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
' Находим выделенные RGB(77, 245, 253) цветом цифры и заменяем на надстрочные
    Selection.Find.ClearFormatting
    Selection.Find.Font.Color = RGB(77, 245, 253)
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Superscript = True
        .Subscript = False
    End With
    With Selection.Find
        .Text = s(1)
        .Replacement.Text = "\1"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
' Находим выделенные RGB(77, 245, 253) цветом все знаки и возвращаем цвет wdAuto
    Selection.Find.ClearFormatting
    Selection.Find.Font.Color = RGB(77, 245, 253)
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.ColorIndex = wdAuto
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

Public Sub Подстрочные()
Dim s As Variant
   
    
    inp = InputBox("Разделитель между словами знак «;;»!!!" & Chr(13) _
                & "Например: (м);;([2;3])!!!" & Chr(13) _
                & "Введите выражение:", "2-е выражение ПОДСТРОЧНЫЕ")
    s = Split(inp, ";;")
    inp = s(0) & s(1)

' Находим нужное выражение и выделяем знаки цветом RGB(77, 245, 253)
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Color = RGB(77, 245, 253)
    With Selection.Find
        .Text = inp
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
' Находим выделенные RGB(77, 245, 253) цветом цифры и заменяем на подстрочные
    Selection.Find.ClearFormatting
    Selection.Find.Font.Color = RGB(77, 245, 253)
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Superscript = False
        .Subscript = True
    End With
    With Selection.Find
        .Text = s(1)
        .Replacement.Text = "\1"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
' Находим выделенные RGB(77, 245, 253) цветом все знаки и возвращаем цвет wdAuto
    Selection.Find.ClearFormatting
    Selection.Find.Font.Color = RGB(77, 245, 253)
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.ColorIndex = wdAuto
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub

11

Re: Что не так с макросом

Я уже писал где-то. Хороший самоучитель Б.Клименко, М.Розенберг «Microsoft Word комфортная работа с помощью макросов»
Вот ссылка
внешняя ссылка
Для новичков будет очень интересна тема использования подстановочных знаков. Что в Вашем случае актуально.

12

Re: Что не так с макросом

Да в подстановочных я вроде более-менее разбираюсь ("ворд регулярки пдф" через гугл, документ там выходит, я в него, если что-нибудь надо, подглядываю). А хотелось бы в VBA научиться. Спасибо за учебник. Начну с него.)

13

Re: Что не так с макросом

Для лучшего понимания используйте такую практику.
1. Определите действия, которые вы хотите изучить.
2. Запишите на их основе макрос.
3. Проанализируйте код макроса, сопоставляя его с порядком действий.
4. После изучения кода попробуйте в уме или запишите на бумаге порядок действий, аналогичный действиям п.1.
5. Напишите код действий п.4.
6. Проверьте правильность действия макроса.
7. Начинайте с не сложных действий.
С практикой придет понимание. smile