Макрос поиска по всему документу

[Polotenchik]

398 - прописная буква, 3B8 - строчная буква

А как перевести? Т.е. я выделяю какой-то символ в окне, он мне показывает код, как мне его перевести в код для макроса? Ну Вы поняли =)

Казанский, спасибо за макрос, сегодня опробую и отпишусь.
Sasha_Smirnov, спасибо за ссылку, тоже ознакомлюсь и отпишусь.

[Казанский]

я выделяю какой-то символ в окне, он мне показывает код, как мне его перевести в код для макроса?

Посмотрел сейчас - и таблица символов Офис 2007, и системная таблица символов ХР показывает код юникода в шестнадцатиричном (HEX) виде. Поэтому дописывайте впереди &H, см. посты от 05.06.2011 19:45, от 05.06.2011, 22:53.
Десятичный код вводится без префикса. ChrW(&h398) это то же, что Chrw(920).

[DivedigopeSop]

Пираты Карибского моря 4 онлайн
Пастырь 2011 онлайн
Ханна. Совершенное оружие онлайн
фильм палата онлайн
фильм Неизвестный онлайн
Области тьмы онлайн
Доброе утро онлайн
Форсаж 5 онлайн
Тор онлайн
Смертельный список онлайн
Линкольн для адвоката онлайн

[Sasha_Smirnov]

Sub code_show()
InputBox Left(Selection, 1), "Юникод символа ", AscW(Selection)
End Sub

Курсор при этом должен стоять перед «раскодируемым» символом.

[Polotenchik]

Опробовал. Результаты печальные. Пробовал так:

Sub Пример1()

With Selection
    .HomeKey Unit:=wdStory
    .Find.ClearFormatting
    With .Find
        .Text = "бла бла бла"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
    End With
    .Find.Execute
    Do
        .MoveUp Unit:=wdLine, Count:=13, Extend:=wdExtend
        .ParagraphFormat.Alignment = wdAlignParagraphLeft
        .Find.Execute
    Loop Until .Text = vbCr
End With
    
End Sub

так (Изменил Loop):

Sub Пример2()

With Selection
    .HomeKey Unit:=wdStory
    .Find.ClearFormatting
    With .Find
        .Text = "бла бла бла"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
    End With
    .Find.Execute
    Do
        .MoveUp Unit:=wdLine, Count:=13, Extend:=wdExtend
        .ParagraphFormat.Alignment = wdAlignParagraphLeft
        .Find.Execute
    Loop Until Not .Find.Found
End With
    
End Sub

и так:

Sub Пример3()

    
    Selection.HomeKey wdStory
    
    With Selection.Find
        Do
            .Text = "бла бла бла"
            .Wrap = wdFindStop
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = True
            .Execute
            Selection.MoveUp Unit:=wdLine, Count:=13, Extend:=wdExtend
            Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
        Loop Until Not .Found
    End With
    

End Sub

Все 3 варианта привели к бесконечному зацикливанию на первом найденном слове бла бла бла. Пришлось вырубать ворд через контр+альт+делит. Word 2010.
Мужики, выручайте. Что не так делаю?

[Polotenchik]

Сообщение от Sasha_Smirnov

Sub code_show()
InputBox Left(Selection, 1), "Юникод символа ", AscW(Selection)
End Sub

Курсор при этом должен стоять перед «раскодируемым» символом.

Большое спасибо! Работает. А как получить код не юникода, а вот такого символа?:

С ним так не прокатывает почему-то. Пробовал AscW менять на Asc - тоже не помогло.

[Sasha_Smirnov]

Да в общем-то так же.

Sub Макрос3()
Dim FontName$
FontName$ = Selection.Font.Name    'запомнили шрифт в точке ввода
    Selection.Font.Name = "Symbol" 'установили (там же) шрифт Symbol
    Selection.TypeText Text:=ChrW(-3975)        'соответствует нажатию Y (буква пси)
Selection.Font.Name = FontName$     'вернули шрифт по умолчанию
End Sub

[Казанский]

Сообщение от Polotenchik

Все 3 варианта привели к бесконечному зацикливанию на первом найденном слове бла бла бла...

Доработал вариант ув. Смирнова:

Sub Пример3()

Dim r As Range
    Selection.HomeKey wdStory
    
    With Selection.Find
        Do
            .Text = "бла бла бла"
            .Wrap = wdFindStop
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = True
            .Execute
            If Not .Found Then Exit Do
            Set r = Selection.Range
            Selection.MoveUp Unit:=wdLine, Count:=13, Extend:=wdExtend
            Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
            r.Select
            Selection.Collapse wdCollapseEnd
        Loop
    End With

End Sub

[Polotenchik]

Казанский, Sasha_Smirnov, большое вам спасибо!
Казанский, макрос превосходный

Sasha_Smirnov, хм. я этот же номер определил, но как мне его вставить? Код:

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "бла бла бла"
        .Font.Name = "Symbol"
        .Replacement.Text = "бла бла бла (" & ChrW(-3975) & "F)"
        .Forward = False
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

вставляет квадратик с вопросиком. Я так понимаю надо как-то подрубить Selection.Font.Name = "Symbol" ? Пробовал, но не получилось.

[Sasha_Smirnov]

Пробовал. Минут 40. И... вот что вышло.

Sub Макрос2()
Dim FontID: FontID = Selection.Font.Name    'запомнили шрифт в точке ввода
Selection.HomeKey wdStory                   'здесь курсор становится на начало текста
    With Selection.Find
        Do
            .Text = "бла бла бла"
            .Wrap = wdFindStop
            .Execute 'здесь (если по F8 пошагово выполнять) выделено очередное бла бла бла
                If .Found Then
                Selection.Collapse direction:=wdCollapseEnd 'выделение сбросили...
                Selection.TypeText " ("                     '...и затем печатаем
                Selection.Font.Name = "Symbol"
                Selection.TypeText ChrW(-3975)              'печать малой греческой пси
                Selection.Font.Name = FontID
                Selection.TypeText "F)"                     'печать всего прочего
                End If
        Loop Until Not .Found
    End With
End Sub