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

[caute]

Имеется англо-немецкий текст, требуется пометить как немецкие + выделить синим цветом (стандартным вордовским: RGB 0,0,255) все слова, в которых встречаются буквы "ö, ü, ä, ß", а также артикли "die, das, ein, eine"
(остальное потом выделю и размечу-покрашу вручную, ориентируясь на синий цвет)
Макрорекордером не сумел. Почему-то он выделение цветом у меня не записывает (Word 2003)

[Скрипт]

caute, может быть у вас в документах есть другой признак, по которому можно отличить немецкое слово от английского, например, немецкий текст идёт после знака "дефис" или "тире"?

[caute]

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

[Скрипт]

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.HighlightColorIndex = wdBlue
            
            'Перемещаем закладку в конец найденного фрагмента,
                'чтобы продолжить дальше поиск по документу.
            myBookmark.Collapse Direction:=wdCollapseEnd
            
        Loop
        
    Next i


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

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


End Sub

[shanemac51]

ради интереса , хотелось вы посмотреть кусочек файла


лично раскрашивала словари
--португало-русские
--англо-русские

конечно это легче
--окрасила все в базовый цвет
--выделила кириллицу --раскрасила
--выбрала курсив --перекрасила

[shanemac51]

нашла кусок нем-анг словаря
раскрасила

[caute]

спасибо, shanemac51 и Скрипт
фрагмент текста прикрепляю
макрос еще не успел попробовать, только вернулся

[caute]

ув. Скрипт, подскажите, плиз, команду аналогичную

Options.DefaultHighlightColorIndex = wdBlue

которая бы красила в синий только шрифт, без highlighting
(для myWord.HighlightColorIndex = wdBlue я нашел такую замену: myWord.Font.ColorIndex = wdBlue)

[Скрипт]

myWord.Font.ColorIndex = wdBlue

[caute]

может, я и лопух, но не настолько же
Run-time error '9':
Subscript out of range