Статьи из блога

Статьи из блога

Поиск слов с прописными буквами

Роман интересуется:

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

Можно воспользоваться следующим макросом, который мне помогли реализовать специалисты VBA с форума microsoft.public.word.vba.general.

 

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

Обратите внимание, что макрос писал не я, по моей просьбе его составили специалисты с указанного выше форума. Тем не менее, я добавил в текст макроса свои поясняющие комментарии (для себя и тех, кому это может быть интересно в плане изучения опыта).
Sub UcaseList()
'Поиск в тексте слов с прописными буквами, копирование их в конец документа, сортировка и удаление повторяющихся
'Помощь от Jean-Guy Marcil и Graham Mayor
'http://groups.google.ru/group/microsoft.public.word.vba.general/
Dim rngDoc As Word.Range
Dim wu As Word.Range
Dim lngDocEnd As Long
Set rngDoc = ActiveDocument.Range
lngDocEnd = rngDoc.End
With ActiveDocument
   Selection.EndKey Unit:=wdStory  'переходим в конец документа
   Selection.TypeParagraph   'вставляем параграф
   .Bookmarks.Add Range:=Selection.Range, Name:="ListStart"   'вставляем закладку
   'для каждого слова проверяем его регистр и если есть слова с прописными буквами, добавляем их в конец документа
   For Each wu In rngDoc.Words
      If wu.Case = wdUpperCase Then
         .Range.InsertAfter vbCrLf & wu.Text
         rngDoc.End = lngDocEnd
      End If
   Next wu
   .Bookmarks("ListStart").Select  'выбираем закладку, выделяем все слова, что идут ниже ее, и сортируем их по алфавиту
   With Selection
      .EndKey Unit:=wdStory, Extend:=wdExtend
      .Sort , FieldNumber:="Paragraphs", _
      SortFieldType:=wdSortFieldAlphanumeric, _
      SortOrder:=wdSortOrderAscending
      'с отсортированными словами
      With .Find
         .ClearFormatting
         .Replacement.ClearFormatting
      'удаляем пробелы после слов
         .Text = "[ ](^13)"
         .Replacement.Text = "\1"
         .MatchWildcards = True
         .Execute Replace:=wdReplaceAll
      'удаляем лишние концы абзацев
         .Text = "(*^13)@"
         .Replacement.Text = "\1"
         .MatchWildcards = True
         .Execute Replace:=wdReplaceAll
      'ищем повторяющиеся слова и удаляем их
         .Text = "([!A-Z-А-ЯЁ])[A-Z-А-ЯЁ]^13"
         .Replacement.Text = "\1"
         .Execute Replace:=wdReplaceAll
      End With
   End With
End With
End Sub

Если вы не знаете, как подключить к документу и применить этот макрос, изучите следующие заметки с сайта:

Создание макроса из готового кода

Автоматическая запись макроса

twitter.com facebook.com vkontakte.ru odnoklassniki.ru mail.ru ya.ru rutvit.ru myspace.com technorati.com digg.com friendfeed.com pikabu.ru blogger.com liveinternet.ru livejournal.ru memori.ru google.com bobrdobr.ru mister-wong.ru yahoo.com yandex.ru del.icio.us

Еще записи по вопросам использования Microsoft Word:

Комментариев: 4

  1. swan
    31.07.2008 в 09:19 | #1

    Огромное спасибо за этот макрос

    спасает при разработке больших документов !!!

  2. Den
    25.11.2008 в 18:14 | #2

    А где же удаление однобуквенных слов?

    Макрос забавный. Спасибо за идею.

  3. Сергей
    21.09.2011 в 12:35 | #3

    Добрый день. Огромное спасибо за данный макрос, однако, у меня есть вопрос, что нужно изменить в этом макросе, чтобы он мог искать слова написанные курсивным шрифтом?

  4. 13.11.2014 в 15:29 | #4

    не работает. Сообщает "Найти" содержит неверный шаблон поиска

Оставьте комментарий!

(обязательно)

^ Наверх