Участник:Al Silonov/Макрос для этимологии

На всякий случай — может, кому-нибудь пригодится: макрос для MS Word, выполняющий первичную обработку этимологии, выдранной из словаря Фасмера. Для установки макроса в Word надо:

1. вызвать меню «Сервис/Макрос/Макросы», в строке Имя ввести etymol и нажать кнопку «Создать». Появится редактор Visual Basic и в нем заготовка типа:
   

Sub etymol()
'
' etymol Макрос
'
End Sub

1. Всю эту заготовку, что стоит между Sub и End Sub, надо заменить текстом, предлагаемым мною (начальная и конечная строки у меня и в заготовке, естественно, совпадают, поэтому можно оставить тамошние а между ними вставлять собственно код).
2. Когда подпрограмма таким образом примет нужный вид, надо дать команду File/Save Normal и закрыть окно Visual Basic.
3. C этих пор в Ворде можно будет вызывать этот макрос. Я поместил его на панель инструментов в виде кнопки, а можно привязать к нему клавишный код (меню «Сервис/Настройка/Клавиатура», в Категориях выбрать «Макросы», в списке макросов — etymol, после чего ввести в поле «Новое сочетание клавиш» что-нибудь типа Ctrl+Shift+E — короче, любую комбинацию, какую не жалко и какая ассоциируется со словом этимология.

Теперь я копирую кусок из Фасмера с сайта покойного Старостина, вставляю в пустое окно Ворда, в конце ставлю точку и пробел, а затем нажимаю кнопку вызова макроса. То, что после этого получается, уже несу в Викисловарь. А вот и текст макроса:

---

Sub etymol()
    ActiveDocument.Range.Select
    With Selection.Find
        .Text = "^l^l"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "чеш."
        .Replacement.Text = "чешск."
        .Forward = True
        .Wrap = wdFindStop
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "словен."
        .Replacement.Text = "словенск."
        .Forward = True
        .Wrap = wdFindStop
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "лтш"
        .Replacement.Text = "латышск"
        .Forward = True
        .Wrap = wdFindStop
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "цслав."
        .Replacement.Text = "церк.-слав."
        .Forward = True
        .Wrap = wdFindStop
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "слвц"
        .Replacement.Text = "словацк"
        .Forward = True
        .Wrap = wdFindStop
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "Further etymology:"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "блр"
        .Replacement.Text = "белор"
        .Forward = True
        .Wrap = wdFindStop
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "гот."
        .Replacement.Text = "готск."
        .Forward = True
        .Wrap = wdFindStop
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ", род."
        .Replacement.Text = " (род."
        .Forward = True
        .Wrap = wdFindStop
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = "в.-н."
        .Replacement.Text = "в.-нем."
        .Forward = True
        .Wrap = wdFindStop
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    With Selection.Find
        .Text = ", вин."
        .Replacement.Text = " (вин."
        .Forward = True
        .Wrap = wdFindStop
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    newstr = "{{#if:{{{1|}}}|{{#switch:{{{1}}}| да= |en= {{OED}}}}{{#switch:{{{1}}}|la=|{{etym-lang|{{{1|}}}|la}}}}}}<noinclude>[[Категория:Шаблоны этимологии|XXXX]]</noinclude>"
    Selection.InsertAfter (newstr)
End Sub