замена прописных и подчеркнутых на курсив

[caute]

заглянул, маска поиска понятна даже для меня
и ясно, что маску замены прописных на строчные так же просто написать не получится
может, использовать список замен буквы на букву, по типу макроса, которым я конвертирую кириллицу в латиницу

Sub Propis()
  Dim sLat() As Variant
  Dim sRus As String
  Dim sOut As String
  sLat = Array("а", "б", "в", "г", "д", "е", "ё", "ж", "з", "и", "й", "к", "л", "м", "н", "о", "п", "р", "с", "т", "у", "ф", "х", "ц", "ч", "ш", "щ", "ъ", "ы", "ь", "э", "ю", "я")
  sRus = "АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ"
  Dim och As Range, Index As Long
  For Each och In Selection.Characters
    Index = InStr(1, sRus, och.Text, vbBinaryCompare)
    If Index <> 0 Then
      sOut = sOut & sLat(Index - 1)
    Else
      sOut = sOut & och.Text
    End If
  Next
'  Selection.Collapse wdCollapseEnd
'  Selection.TypeParagraph
  Selection.TypeText sOut
End Sub

[caute]

чё, никто так и не поможет? осталась-то пара штрихов, за 5 мин. птичке долететь

[Sasha_Smirnov]

Как вордист вордисту, дам пока намёк: изменение регистра в выделении: шифт-F3.

Жаль, что вам приходится за бесноватого автора* расхлёбывать неделями… [оставил для связности темы].

Насчёт 5 минут «для профи»: лестно слышать, но на самом деле это часа 2, и то если не отвлекают!
_________________
* я о технической стороне писания книг; и вообще: классик курсивами не частит (по Чехову)

[caute]

намеки девушкам приятны, а народу треба хлеба и макросов.
как я понял, в макросе должно быть три части:
1. выделение слов, написанных прописными буквами (имеется команда, выделяющая их поочередно, а нужна - скопом)
2. форматирование выделенного курсивом
3. замена прописных букв на строчные (макрос вверху, работает, проверил, но он меняет ВСЕ прописные, а не только нужные)
Ну и в заключение объединить все эти команды в одно целое.

P.S. не обижайте автора, Саша, это лучший философ XX века, имхо
просто не было курсива у него на пишмашинке, тогда многие прописью выделяли

[Борис_Р]

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

как я понял, в макросе должно быть три части:
1. выделение слов, написанных прописными буквами (имеется команда, выделяющая их поочередно, а нужна - скопом)
2. форматирование выделенного курсивом
3. замена прописных букв на строчные

Выделение слов, написанных прописными буквами и форматирование выделенного курсивом
Если нужно скопом, то используем поиск и замену с подстановочными знаками.
Строка поиска, подстановочные знаки включены:
(<[А-ЯЁ]{2;}>)
Строка замены:
\1
формат - шрифт курсив
Заменить все
Затем CTRL+A (выделить весь текст) и заменить регистр букв, сначала "все строчные", затем "как в предложениях".
(можно три раза SHTFT+F3)
Если нужен макрос, то включаем макрорекодер и записываем приведенную последовательность действий.

[caute]

в принципе, вручную проблема решена благодаря возможности выделить нужные слова

        .Text = "(<[А-ЯЁ]{2;}>)"
        .Replacement.Text = "\1"
        .MatchWildcards = True

далее команды ChangeCase и Italic
С макрорекордером не получилось. Вариант с выделением всего текста мне не подходит.
А команда Selection.Range.Case = wdTitleSentence меняет только первое из выделенных слов.

[caute]

ну, ладно, и на том всем спасибо

[Sasha_Smirnov]

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

...меняет только первое из выделенных слов.

Но сэр!

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

Нет никаких препон и для многоразовой замены (через Selection.Find)!

На наше счастье, на форуме есть люди, которые

Сообщение от Vladimir_K.

целый год учились в word работать

[caute]

Нет никаких препон и для многоразовой замены (через Selection.Find)!

сэр, прошу Вас поделиться развернутым мнением, желательно готовым кодом
моей квалификации не хватает

[shanemac51]

попробуйте на копии

Option Explicit

Sub A______SH150809()
Dim J1
Word.ActiveDocument.Select
Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find.Replacement.Font
        .Italic = True
        .Color = vbRed
        ''-587137025
    End With
    J1 = Word.ActiveDocument.Words.Count / 4
    Do While J1 > 0
    With Selection.Find
        .Text = "(<[А-ЯЁ]{2;}>)"
        .Replacement.Text = "\1"
        '.Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        If .Forward = True Then
            Selection.Collapse Direction:=wdCollapseEnd
        Else
            Selection.Collapse Direction:=wdCollapseStart
        End If
   
    .Execute Replace:=wdReplaceOne
    End With
With Selection.Range
Debug.Print .Start, .End, .Text
If .Start = .End Then Exit Do
''If Len("" & .Text) < 2 Then Exit Do
.Case = wdLowerCase
J1 = J1 - 1
End With
Loop
End Sub