Задать язык и выделить цветом

[shanemac51]

попробуйте макрос в документе

[Скрипт]

caute, какой у вас сейчас вопрос?

[caute]

shanemac51, выделяет всё, что в кавычках или просто шевелится
иногда добавляет курсив без спросу

Скрипт
чем заменить
Options.DefaultHighlightColorIndex = wdBlue
чтоб красился синим шрифт, без подсветки фона (хайлайта)?

[Скрипт]

caute, а код из сообщения #9 что делает не так?

Вот внёс изменения в двух местах:

Sub Procedure_1()
    
    Dim myCharecters(1 To 4) As Long
    Dim myArticles(1 To 3) As String
    Dim myBookmark As Word.Range
    Dim myFind As Word.Find
    Dim myWord As Word.Range
    Dim i As Long
    
    
    '1. Помещаем в массив "myCharecters" юникод-коды
        'символов. Помещаем в массив, чтобы можно
        'было использовать в коде цикл. С циклом код меньше получится.
    myCharecters(1) = 223
    myCharecters(2) = 228
    myCharecters(3) = 246
    myCharecters(4) = 252
    
    
    '2. Помещаем в массив "myArticles" артикли.
    myArticles(1) = "das"
    myArticles(2) = "die"
    myArticles(3) = "ein"
    
    
    '3. Создаём виртуальную закладку с помощью которой
        'будем перемещаться по документу. Даём этой закладке
        'VBA-имя "myBookmark".
    'Вставляем закладку в начало документа.
    Set myBookmark = ActiveDocument.Range(Start:=0, End:=0)
    
    
    '4. Создаём объект, который будет искать.
        'Даём этому объекту VBA-имя "myFind".
    Set myFind = myBookmark.Find
    
    
'-----------------------------------------------------------------------------------------------------
    '5. ПОИСК НЕМЕЦКИХ СЛОВ ПО СПЕЦИАЛЬНЫМ СИМВОЛАМ.
    
    'В цикле с "i" просматриваем все символы в массиве.
    For i = 1 To UBound(myCharecters) Step 1
    
        'Ставим закладку в начало документа.
        myBookmark.SetRange Start:=0, End:=0
        
        'Указываем, какой текст искать.
        'Переводим число в символ, т.к. команда "Find" с символами работает,
            'а не с кодами символов.
        myFind.Text = ChrW(myCharecters(i))
        
        'Продолжаем поиск, пока находится искомый текст.
        Do While myFind.Execute = True
        
            'Если будет найдено, то закладка окружит найденный текст.
            'По этой закладке получаем доступ к слову.
            Set myWord = myBookmark.Words(1)
            
            'Программа "Word" включает в слово и пробел, который
                'идёт за словом, поэтому, если справа есть пробел,
                'то убираем его из слова.
            'Count:=wdBackward - двигаем конец слова в начало документа.
            myWord.MoveEndWhile Cset:=" ", Count:=wdBackward
            
            'Делаем у слова нужный язык.
            myWord.LanguageID = wdGerman
            
            'Делаем у слова нужный цвет.
            myWord.Font.ColorIndex = wdBlue
            
            'Перемещаем закладку в конец найденного фрагмента,
                'чтобы продолжить дальше поиск по документу.
            myBookmark.Collapse Direction:=wdCollapseEnd
            
        Loop
        
    Next i


'-----------------------------------------------------------------------------------------------------
    '6. ПОИСК НЕМЕЦКИХ СЛОВ ПО АРТИКЛЯМ.
    
    '6.1. Устанавливаем закладку в начало документа.
    myBookmark.SetRange Start:=0, End:=0
    
    
    '6.2. Делаем настройки в объекте "Find".
    '6.2.1. Буду использовать подстановочные знаки.
    myFind.MatchWildcards = True
    
    '6.2.2. Заменять на немецкий язык будем с помощью команды "Find".
    myFind.Replacement.LanguageID = wdGerman
    
    '6.2.3. Выделять цветом будем с помощью команды "Find".
    myFind.Replacement.Font.ColorIndex = wdBlue
    
    
    'В цикле с "i" просматриваем артикли в массиве "myArticles".
    For i = 1 To UBound(myArticles) Step 1
        
        'Ищем в начале слова артикль, затем пробел, затем
            'любое количество символов до конца слова.
        myFind.Text = "<" & myArticles(i) & " *>"
        
        myFind.Execute Replace:=wdReplaceAll
        
    Next i

'-----------------------------------------------------------------------------------------------------


End Sub

[caute]

теперь всё как надо! спасибо, супер
добавил в код еще артиклей и пр.
по комментам в вашем коде так, глядишь, и на программиста выучусь

[shanemac51]

с курсивом перестаралась

Sub a__de_en_130530_2119()
 Selection.Find.ClearFormatting
 Selection.Find.Replacement.ClearFormatting
 With Selection.Find.Replacement.Font
  ''.Italic = True
  .Color = wdColorRed
 End With
 With Selection.Find
  .Text = "\" & ChrW(8220) & "*\" & ChrW(8221)
  .Replacement.Text = ""
  .Forward = True
  .Wrap = wdFindContinue
  .Format = True
  .MatchCase = False
  .MatchWholeWord = False
  .MatchByte = False
  .MatchAllWordForms = False
  .MatchSoundsLike = False
  .MatchWildcards = True
 End With
 Selection.Find.Execute Replace:=wdReplaceAll
''''''''''''''''''''''''''
'
 Selection.Find.ClearFormatting
 Selection.Find.Replacement.ClearFormatting
 With Selection.Find.Replacement.Font
  ''.Italic = True
  .Color = wdColorRed
 End With
 With Selection.Find
  .Text = "\(*\)"
  .Replacement.Text = ""
  .Forward = True
  .Wrap = wdFindContinue
  .Format = True
  .MatchCase = False
  .MatchWholeWord = False
  .MatchByte = False
  .MatchAllWordForms = False
  .MatchSoundsLike = False
  .MatchWildcards = True
 End With
 Selection.Find.Execute Replace:=wdReplaceAll
 ActiveWindow.ActivePane.VerticalPercentScrolled = 67
End Sub

[caute]

shanemac51, штука в том, что по тексту много английских цитат в кавычках, а их красить не надо, да и нем. язык ваш макрос не задает покрашенным словам.
По сути, макрос Скрипта решает задачу с максимально возможным эффектом. Дальнейшая автоматизация, насколько я вижу, может идти только по линии добавления предлогов и пр. ходовых немецких слов, отсутствующих в английском языке. Это я осилил.

[shanemac51]

чисто немецкая фраза
“die tätige Seite abstrakt im Gegensatz zu dem Materialismus von dem Idealismus”
Скриптом не выделяется

----
поверьте
в школе я учила немецкий

[shanemac51]

просмотрела я текст по-внимательнее

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


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

попытаюсь найти умлаут вне кавычек-скобок

[caute]

не мучьтесь, милая shanemac51, я уже перекрасил все файлы, завтра закончу дело
когда еще такая работа в таком объеме свалится