1

Тема: Необх-мо найти выделенный текст и подчеркнуть

Здрвствуйте!

Необх-мо в Worde найти выделенный текст (залито зеленым цветом) и подчеркнуть.

2

Re: Необх-мо найти выделенный текст и подчеркнуть

выделяете нужное и магнитофон на запись, ок?

3

Re: Необх-мо найти выделенный текст и подчеркнуть

Ципихович Эндрю пишет:

выделяете нужное и магнитофон на запись, ок?

почему то не работает sad

Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Text = wdGreen
While Selection.Find.Execute = True
    i = 0
    While Selection.Text <> wdGreen
    Selection.MoveLeft Unit:=wdCharacter, Count:=15, Extend:=wdExtend
    Selection.Font.UnderlineColor = wdColorAutomatic
    Selection.Font.Underline = wdUnderlineSingle
      i = i + 1
     
    Wend
Wend

Post's attachments

пример.doc 21.5 Кб, 1 скачиваний с 2012-04-30 

You don't have the permssions to download the attachments of this post.

4

Re: Необх-мо найти выделенный текст и подчеркнуть

вы реально на запись ставили?

5

Re: Необх-мо найти выделенный текст и подчеркнуть

Ципихович Эндрю пишет:

вы реально на запись ставили?

реально.

6

Re: Необх-мо найти выделенный текст и подчеркнуть

я тоже поставил

Selection.Find.ClearFormatting
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    If Selection.Font.Underline = wdUnderlineNone Then
        Selection.Font.Underline = wdUnderlineSingle
    Else
        Selection.Font.Underline = wdUnderlineNone
    End If

не увидел магических
Wend
Wend

7

Re: Необх-мо найти выделенный текст и подчеркнуть

согласен, эту строку Selection.HomeKey Unit:=wdStory вверху можно оставить

8

Re: Необх-мо найти выделенный текст и подчеркнуть

Ципихович Эндрю пишет:

я тоже поставил

Selection.Find.ClearFormatting
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    If Selection.Font.Underline = wdUnderlineNone Then
        Selection.Font.Underline = wdUnderlineSingle
    Else
        Selection.Font.Underline = wdUnderlineNone
    End If

не увидел магических
Wend
Wend

я так понимаю в строках нужно дописать след-ее:
      With Selection.Find
        .Text = wdGreen
        .Replacement.Text = ""Selection.Font.Underline = wdUnderlineSingle

Так или не так ?

9

Re: Необх-мо найти выделенный текст и подчеркнуть

cobra77777 пишет:
Ципихович Эндрю пишет:

я тоже поставил

Selection.Find.ClearFormatting
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    If Selection.Font.Underline = wdUnderlineNone Then
        Selection.Font.Underline = wdUnderlineSingle
    Else
        Selection.Font.Underline = wdUnderlineNone
    End If

не увидел магических
Wend
Wend

я так понимаю в строках нужно дописать след-ее:
      With Selection.Find
        .Text = wdGreen
        .Replacement.Text = Selection.Font.Underline = wdUnderlineSingle

Так или не так ?

10

Re: Необх-мо найти выделенный текст и подчеркнуть

.Text = wdGreen - нет, это то что ищете, как Вы указали вы ищете переменную wdGreen, то есть если бы выше было wdGreen = "ав", это бы означало, что Вы ищете ав, а так ничего не ищем - т.е. любой текст
        .Replacement.Text = ""Selection.Font.Underline = wdUnderlineSingle - нет, это то на что меням, ни на что не меняем
То есть ничего не ищем и ни на что не меняем, просто выделяем, а потом выделенное подчёркиваем

11

Re: Необх-мо найти выделенный текст и подчеркнуть

Ципихович Эндрю пишет:

.Text = wdGreen - нет, это то что ищете, как Вы указали вы ищете переменную wdGreen, то есть если бы выше было wdGreen = "ав", это бы означало, что Вы ищете ав, а так ничего не ищем - т.е. любой текст
        .Replacement.Text = ""Selection.Font.Underline = wdUnderlineSingle - нет, это то на что меням, ни на что не меняем
То есть ничего не ищем и ни на что не меняем, просто выделяем, а потом выделенное подчёркиваем

Недоработка в коде есть, в том плане, что когда я выделяю весь документ (а он порядка из 200 страниц у меня в word) , то выделяется всё. Хотелось бы как в моем примере выделялись только определенные слова.

12

Re: Необх-мо найти выделенный текст и подчеркнуть

там расписано всё

13

Re: Необх-мо найти выделенный текст и подчеркнуть

сноровку нужно иметь....

Post's attachments

Find Find Find.doc 44.5 Кб, 1 скачиваний с 2012-04-30 

You don't have the permssions to download the attachments of this post.

14

Re: Необх-мо найти выделенный текст и подчеркнуть

Ципихович Эндрю пишет:

сноровку нужно иметь....

Спасибо за присланные алгоритмы Эндрю, но мой вопрос так и остался не решенным sad.
И потом никак я не пойму:
>То есть ничего не ищем и ни на что не меняем, просто выделяем, а потом выделенное подчёркиваем.
Я считаю, нам надо все таки найти текст (выделенный заливкой), а потом как найдем текст сделать нижнее подчеркивание. Я спрашивал как найти выделенный заливкой текст, мы все таки все равно должны где то это указать ?

15

Re: Необх-мо найти выделенный текст и подчеркнуть

Чтобы найти выделенный цветом текст, это нужно указать. Вот что дала запись макроса:

Sub Макрос1()
'
' Макрос1 Макрос
'
'
    Selection.Find.ClearFormatting
    Selection.Find.Highlight = True
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Underline = wdUnderlineSingle
    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
End Sub

Нужно обратить внимание на вторую строчку кода: именно она и указывает, что текст должен быть выделен цветом. Правда, как указать цвет выделения, я не нашёл. Но это не беда, небольшое допиливание напильником и всё заработает. Вместо последней строчки Selection.Find.Execute, нужно записать:

While Selection.Find.Execute
        If Selection.Range.HighlightColorIndex = wdGreen Then
            Selection.Font.Underline = wdUnderlineSingle
        End If
Wend
Лучше день потерять — потом за пять минут долететь!

16

Re: Необх-мо найти выделенный текст и подчеркнуть

Вот макрос

Sub Макрос1()
'
' Макрос1 Макрос
'
'
'
Dim booFind As Boolean, rng As Range, rngEnd As Long
    Set rng = Selection.Range
    rngEnd = rng.End
    booFind = True
    Do
        rng.Find.ClearFormatting
        rng.Find.Highlight = True
            With rng.Find
                .Text = ""
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindContinue
                .Format = True
                .Execute
                    If .Found = True Then
                        If rng.HighlightColorIndex = wdYellow Then
                            rng.Font.Underline = wdUnderlineSingle
                            rng.HighlightColorIndex = wdAuto
                        On Error Resume Next
                            Set rng = ActiveDocument.Range(rng.End, rngEnd)
                                If Err.Number > 0 Then Exit Do
                        End If
                    Else
                        Exit Do
                    End If
            End With
        Loop
End Sub

17

Re: Необх-мо найти выделенный текст и подчеркнуть

aap77, вот эта задача как раз из тех, где применение объекта Range не оправдано, т.к. становится больше кода и лишних операций. А именно, когда нужно при поиске вводить свои действия с найденным текстом, то лучше пользоваться Selection, т.к. после выполнения пользовательских действий над текстом поиск продолжается, а в случае с Range он прерывается и необходимо переопределять диапазон для запуска нового поиска.

Лучше день потерять — потом за пять минут долететь!

18

Re: Необх-мо найти выделенный текст и подчеркнуть

что-то я советовал, а теперь сам в ступоре, с выделением работает, а если просто шрифт зелёный - не работает

Sub Ищём_выделенное_цветом_wdGreen_и_подчёркиваем()

    Selection.Find.ClearFormatting
    Selection.Find.Highlight = True
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Underline = wdUnderlineSingle
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    While Selection.Find.Execute
    'цвет зелёный
    If Selection.Font.Color = wdColorGreen Then
    'выделение зелёным цветом
        'If Selection.Range.HighlightColorIndex = wdGreen Then
            'сделать шрифт подчёркнутым
            Selection.Font.Underline = wdUnderlineSingle
        End If
     Wend

End Sub

19

Re: Необх-мо найти выделенный текст и подчеркнуть

Ципихович Эндрю пишет:

что-то я советовал, а теперь сам в ступоре, с выделением работает, а если просто шрифт зелёный - не работает

Sub Ищём_выделенное_цветом_wdGreen_и_подчёркиваем()

    Selection.Find.ClearFormatting
    Selection.Find.Highlight = True
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Underline = wdUnderlineSingle
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    While Selection.Find.Execute
    'цвет зелёный
    If Selection.Font.Color = wdColorGreen Then
    'выделение зелёным цветом
        'If Selection.Range.HighlightColorIndex = wdGreen Then
            'сделать шрифт подчёркнутым
            Selection.Font.Underline = wdUnderlineSingle
        End If
     Wend

End Sub

Пробежался быстренько, но опять но sad не подчеркнул.

20

Re: Необх-мо найти выделенный текст и подчеркнуть

Товарищи, в том-то и дело, что у объекта Find, есть такое замечательное свойство как Found, после выполнения оператора Execute, если Found = True, то с найденным фрагментом можно делать все, что позволяет код VBA, в том числе, и задавать дополнительные условия, а потом уже выполнять операции по замене. У Вас же в примерах цикл While Selection.Find.Execute…Wend выполняется только к первому найденному фрагменту. Так же в моем примере использован объект Range основе обекта Selection и свойство rngEnd = rng.End для определения точки выхода из цикла во избежание зацикливания программы

21

Re: Необх-мо найти выделенный текст и подчеркнуть

aap77 пишет:

…У Вас же в примерах цикл While Selection.Find.Execute…Wend выполняется только к первому найденному фрагменту…

Он выполняется к каждому найдённому фрагменту по очереди. Т.е. сначала у меня задаются условия поиска, а затем поиск вызывается в цикле While.
aap77, я не говорю, что твой код не правильный. Он не оптимальный
cobra77777, попробуй макросы из сообщений 15 и 16 этого должно хватить

Лучше день потерять — потом за пять минут долететь!

22

Re: Необх-мо найти выделенный текст и подчеркнуть

ВСЕМ БОЛЬШОЕ СПАСИБО ЗА ПОМОЩЬ. ВСЕ ПОЛУЧИЛОСЬ УРАААААААА.
РАБ.КОД:


Sub Макрос1()
'
' Макрос1 Макрос
Selection.Find.ClearFormatting
    Selection.Find.Highlight = True
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Underline = wdUnderlineSingle
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    While Selection.Find.Execute
        If Selection.Range.HighlightColorIndex = wdGreen Then
            Selection.Font.Underline = wdUnderlineSingle
        End If
Wend
End Sub