Как найти все сокращения в документе MS Word с помощью макроса?

Question

У меня есть документ со многими аббревиатурами, которые нужно записать и поместить в таблицу сокращений в конце документа.

Термин аббревиатура имеет различные значения. Я хотел бы создать таблицу, в которой есть все слова, которые инициализируются; две или более заглавные буквы, которые являются короткими для более длинного значения. Т.е. CD-ROM, USB, SYNC, MMR, ASCAP и т. Д.

Как мне создать макрос для этого?

Answer 1

Нечто подобное может начать вас. Добавьте ссылку на "Регулярные выражения Microsoft VBScript" ("Редактировать макрос: Инструменты> Ссылки"). Эта библиотека представляет собой файл "vbscript.dll".

Возможно, вам придется настроить регулярное выражение, если все ваши аббревиатуры не только заглавные буквы (например, некоторые могут содержать цифры).

Sub Acronyms()

    Dim dict, k, tmp
    Dim regEx, Match, Matches
    Dim rngRange As Range
    Set regEx = New RegExp
    Set dict = CreateObject("scripting.dictionary")

    regEx.Pattern = "[A-Z]{2,}" '2 or more upper-case letters
    regEx.IgnoreCase = False
    regEx.Global = True
    Set Matches = regEx.Execute(ActiveDocument.Range.Text)
    For Each Match In Matches
        tmp = Match.Value
        If Not dict.Exists(tmp) Then dict.Add tmp, 0
        dict(tmp) = dict(tmp) + 1
    Next

    For Each k In dict.Keys
        Debug.Print k, dict(k)
    Next k

End Sub

Answer 2

Спасибо, Тим, ваш код работает отлично!

Если это будет полезно для других, шаблон [A-Z]{1,}([a-z]*|\&|\.*)[A-Z]{1,} найдете больше сокращений...

(У меня нет разрешения на публикацию комментариев, поэтому я добавляю это как ответ)

Изменить (все еще нет возможности добавлять комментарии): \b[A-Z]{1,}([a-z*]|\&|\.|\-)[A-Z]{1,}\b является более устойчивым, но потерпит неудачу, если последний символ аббревиатуры не будет прописным.

Answer 3

Я нашел следующие работы хорошо (где некоторые аббревиатуры названия компании терпимы). Я использую это для проверки ввода данных в Access, он также должен работать для диапазона документов Word.

objRegExp.Pattern = "([A-Z]{1,}((\&(?![A-Z]\s[\w]{3})\w*)+|\.\w*)+)|[A-Z]{2,}(?![A-Z]*\s[A-Z]{1}[a-z])"

• J & K = Матч
• JK&S = Матч
• JSS = совпадение
• JK & S.K = Match
• JSK = Матч
• JK = Матч
• DKD And Sons = Нет совпадений
• J&K Engineering = Нет совпадения
• PKF Rogers and Associates = Нет совпадений

Я использую RegExHero для проверки своих выражений

Answer 4

Я использовал следующее, чтобы найти сокращения в моей докторской диссертации. Все они были в "()".

regEx.Pattern = "\([A-Z]{1,}([a-z]*|\&|\.|\-*)[A-Z]{1,}\)"

Answer 5

Вы будете запускать макрос в основном документе Word. Откройте отдельный документ Word, который является пустым. Это будет использоваться для хранения обнаруженных сокращений.

1. Нажмите "Запись макроса". Выберите уникальное имя и назначьте сочетание клавиш, например, CTRL + ALT + A.
2. Откройте диалог поиска (CTRL + F). Вставьте следующий текст поиска: <[A-Z]{2,}>. В диалоговом окне "Найти" выберите "Еще" > установите флажок "Использовать подстановочные знаки". Нажмите кнопку "Найти далее".
3. Щелкните правой кнопкой мыши по выделенному тексту, стараясь не менять подсветку. Выберите Копировать в контекстном меню.
4. Перейдите к отдельному документу Word (ALT + TAB, выберите документ Word). Вставьте скопированный текст и нажмите Enter. ALT + TAB вернуться к исходному документу Word.
5. Закройте диалог поиска и один раз нажмите стрелку вправо. Это убирает курсор с выделенного текста и подготавливает его для следующего поиска.
6. Остановите запись макроса.

Теперь у вас есть макрос, который находит слово, содержащее две или более заглавные буквы, и сохраняет текст в отдельный документ. Для поиска оставшихся сокращений нажимайте CTRL + ALT + A непрерывно, пока не будет достигнут конец документа. Или отредактируйте макрос и добавьте пока цикл.

Вот как выглядит макрос (без цикла):

Sub GetAcronyms()
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "<[A-Z]{2,}>"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute
    Selection.Copy
    Windows("Document1.docx").Activate
    Selection.PasteAndFormat (wdPasteDefault)
    Selection.TypeParagraph
    Windows("TheOriginalDocument.docx").Activate
    Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub