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

Макрос пакетной замены от Александра Витера

По просьбам читателей сайта Александр Витер разработал свой вариант макроса пакетной замены фрагментов текста в документах Word. Об этом его просили в комментариях к заметке Поиск и замена текста во многих документах одновременно.

Александр предлагает скачать (ниже) бета-версию его разработки кто заинтересован в подобном решении. Вот, что он предлагает.

 

Это третья бета-версия макроса пакетной замены. Теперь ее нужно тестировать.

 

Что уже сделано:

1. Доработан механизм поиска в документе. Текст можно заменять как в основном тексте, так и в надписях, в гиперссылках и объектах WordArt.

2. Добавлены опции «Учитывать регистр» и «Слово целиком».

3. Если файл доступен только для чтения, то он просто пропускается. Запись об этом делается в лог-файл. Таким образом, можно работать и с документами в локальной сети.

4. Глубина вложенности каталогов, в которых можно искать файлы, удовлетворяющие шаблону, не ограничена.

5. Каждый сеанс поиска\замены записывается в подробный лог-файл с указанием документа, проведенных в нем замен, затраченного времени и настроек замены.

6. В процессе поиска\замены отображается прогресс-бар.

 

Я со своей стороны провел тесты, у меня ошибок не возникает. Возможные ошибки я постарался предусмотреть, но над этим еще нужно будет работать.

 

Итак, пожалуйста скачивайте макрос и пробуйте его в деле. Все замечания по макросу (ошибки, предложения) пишите в комментариях к этой заметке.

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:

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

  1. Николай
    25.09.2009 в 03:05 | #1

    Добрый день!

    С интересом читаю ваш проект. Спасибо за полезный труд!

    У меня есть пара вопросов по Word. Думаю, многим будут они интересны. К сожалению, не разобрался, как можно опубликовать эти вопросы на сайте? Если не затруднит, подскажите, пожалуйста.

    Заранее благодарю.

    С уважением, Николай

  2. 25.09.2009 в 16:14 | #2

    Николай, вопросы (и ответы) публикую на сайте я сам. А задать их вы можете через наш Форум.

  3. Игорь
    08.10.2009 в 09:31 | #3

    а) Не хватает подробной информации в логе: сколько замен сделано, сколько и каких строк найдено.

    б) Нужен то ли запрос нf запись итогового файла, то ли предусмотреть бэкап.

    в) Хотелось бы поиска/замены с использованием регулярных выражений: например, мне надо не просто найти строки, а убить их, не оставляя пустых абзацев. Найти строки и заменить на них же, но с добавлением своей строки. Найти и заменить формат. Ну и всё остальное, что может показаться "бешенством с жиру".

    А в предложенном варианте работает как зверь. Автору респект!

  4. Ольга
    13.10.2009 в 22:15 | #4

    Спасибо за макрос, работает хорошо.

    Присоединяюсь к пожеланиям Игоря (см.выше).

    Ещё раз спасибо.

  5. 14.10.2009 в 08:24 | #5

    Игорь и Ольга!

    Я думал с самого начала о возможности записи в лог-файл количества замен. Но это очень сильно затормозит работу макроса (приблизительно на 40%), потому что встроенного механизма, чтобы получить это число, у Word'а нет;

    Перезапись исходного файла я сделаю в виде опции в диалоговом окне;

    Регулярные выражения стоят у меня в TODOlist, но не доходят руки smile

  6. Рамиль
    12.11.2009 в 21:25 | #6

    Огромный респект Автору.

    Программка супер - то, что доктор прописал.

    Поработав немного понял, что мне катастрофически не хватает подробной информации в логе: сколько замен сделано и каких строк найдено.

    В моем случае можно пожертвовать временем но инфу о количестве замен нужно знать.

    Немного доработал программку:

    1) Возможность выбора замены только в основном тексте (мне лично пригодилось);

    2)Добавляет запись в лог о количестве сделанных замен или отсутствии таковых;

    Провел испытания на затрачиваемое время, использовал 10 документов в каждом 10 000 изменений.

    1)Исходная программа

    Обработано 10 документов

    Затрачено 413,047 сек.

    2)Доработанная

    Обработано 10 документов

    Затрачено 537,281 сек.

    Разница 120 сек - для такого огромного объема в моем случае приемлемо.

    Кому интересна версия с указанными доработками вот ссылка .

    Автору еще раз ОГРОМНОЕ спасибо.

    Обилие комментариев в исходном коде - очень помогло.

  7. стас
    27.11.2009 в 12:36 | #7

    Может я не совсем по теме, но подскажите можно ли написать такой макрос, который находит фрагмент текста и копирует его в новый файл, и в месте с фрагментом копирует символов 50 вверх и вниз от фрагмента. Это возможно?

  8. 27.11.2009 в 13:49 | #8

    Посмотрите как пример.

  9. 27.11.2009 в 13:49 | #9

    Можно, например таким макросом

    Sub CopyText()
      Dim oDoc As Document 'Исходный документ
      Dim oNewDoc As Document 'Новый документ
      Dim sSearchString As String 'Строка поиска
      Dim nStart As Long, nEnd As Long 'Начало и конец текста, который нужно скопировать
      
      Set oDoc = ActiveDocument
      sSearchString = Selection.Text
      With oDoc.Range.Find
        .Text = sSearchString
        .Execute
        If .Found Then
          'Если начало найденного фрагмента отстоит от начала документа менее, чем на 50 символов
          nStart = IIf(.Parent.Start < 50, 0, .Parent.Start - 50)
          'Если конец найденного фрагмента отстоит от конца документа менее, чем на 50 символов
          nEnd = IIf(oDoc.Range.End - .Parent.End < 50, oDoc.Range.End, .Parent.End + 50)
          Set oNewDoc = Documents.Add
          oNewDoc.Range.InsertAfter oDoc.Range(nStart, nEnd).Text
        End If
      End With
      Set oDoc = Nothing
      Set oNewDoc = Nothing
    End Sub

  10. стас
    01.12.2009 в 16:15 | #10

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

    Sub Макрос1()
    Dim oDoc As Document 'Исходный документ
      Dim oNewDoc As Document 'Новый документ
      Dim sSearchString As String 'Строка поиска
      Dim nStart As Long, nEnd As Long 'Начало и конец текста, который нужно скопировать
      
      Do
      sSearchString = InputBox("Введите слово в поле:", "Поиск слов")
      If sSearchString = 0 Then
         Exit Sub
      ElseIf Len(sSearchString) = 0 Then
         MsgBox "Введите пожалуйста слово" & vbCr & "или нажмите кнопку 'Cancel"
      End If
      Loop Until Len(sSearchString)  0
    Application.ScreenUpdating = False
    Set newDoc = Documents.Add
      Set oDoc = ActiveDocument
       With oDoc.Range.Find
        .Text = sSearchString
        .Execute
        
        'Ищем слово в любом регистре
    With actDoc.Range.Find
      .Text = ""
      .MatchWildcards = True
      While .Execute
        Application.StatusBar = "Добавляем " & sSearchString
          Wend
    End With
           
        If .Found Then
          'Если начало найденного фрагмента отстоит от начала документа менее, чем на 50 символов
          nStart = IIf(.Parent.Start < 50, 0, .Parent.Start - 50)
          'Если конец найденного фрагмента отстоит от конца документа менее, чем на 50 символов
          nEnd = IIf(oDoc.Range.End - .Parent.End < 50, oDoc.Range.End, .Parent.End + 50)
          Set oNewDoc = Documents.Add
          oNewDoc.Range.InsertAfter oDoc.Range(nStart, nEnd).Text
        End If
      End With
      Set oDoc = Nothing
      Set oNewDoc = Nothing
        CommandBars("Stop Recording").Visible = False
    End Sub

  11. 01.12.2009 в 21:14 | #11

    Поясните подробнее, что нужно сделать.

  12. стас
    02.12.2009 в 10:14 | #12

    Александр, здравствуйте. Нужно чтобы при загрузки макроса появлялось окно InputBox для ввода данных(слово или число) которые нужно найти, затем шел поиск этого слова или числа, а затем скопировать найденные данные в новый документ с диапазоном в 100 символов от указанного слова или числа, то есть 50 символов до и 50 после.

    Ваш макрос работает отлично, но нужно чтобы данные не выделялись вручную , а вводились и искались автоматически, с копированием в новый документ.

  13. 02.12.2009 в 14:47 | #13

    …Ваш макрос работает отлично, но нужно чтобы данные не выделялись вручную , а вводились и искались автоматически, с копированием в новый документ.

    Нужно просто изменить способ задания строки. В моём макросе строку

    sSearchString = Selection.Text

    нужно заменить на такую:

    'Приглашение на ввод строки
      sSearchString = InputBox("Введите слово в поле:", "Поиск слов")
      'Если ничего не ввели или нажали «Отмена», то выходим из процедуры.
      If Len(sSearchString) = 0 Then Exit Sub

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

    Set oNewDoc = Documents.Add

    нужно поставить перед блоком

    With oDoc.Range.Find
    …
    End With

  14. стас
    03.12.2009 в 13:35 | #14

    Александр, здравствуйте. Не происходит поиска по всему документу все рекомендации выполнил. Ввожу слово,создается документ, в нем диапазон в 100 символов и все дальше искать не хочет.

    Sub CopyText()
      Dim oDoc As Document 'Исходный документ
      Dim oNewDoc As Document 'Новый документ
      Dim sSearchString As String 'Строка поиска
      Dim nStart As Long, nEnd As Long 'Начало и конец текста, который нужно скопировать
      
      Set oDoc = ActiveDocument
      'Приглашение на ввод строки
      sSearchString = InputBox("Введите слово в поле:", "Поиск слов")
      'Если ничего не ввели или нажали «Отмена», то выходим из процедуры.
      If Len(sSearchString) = 0 Then Exit Sub
      Set oNewDoc = Documents.Add  
      With oDoc.Range.Find
        .Text = sSearchString
        .Execute
        If .Found Then
          'Если начало найденного фрагмента отстоит от начала документа менее, чем на 50 символов
          nStart = IIf(.Parent.Start < 50, 0, .Parent.Start - 50)
          'Если конец найденного фрагмента отстоит от конца документа менее, чем на 50 символов
          nEnd = IIf(oDoc.Range.End - .Parent.End < 50, oDoc.Range.End, .Parent.End + 50)
          
          oNewDoc.Range.InsertAfter oDoc.Range(nStart, nEnd).Text
        End If
      End With
      Set oDoc = Nothing
      Set oNewDoc = Nothing
    End Sub

  15. 03.12.2009 в 14:00 | #15

    Замените этот блок

    With oDoc.Range.Find
    …
    End With

    На такой:

    With oDoc.Range.Find
        .Text = sSearchString
        While .Execute
          'Если начало найденного фрагмента отстоит от начала документа менее, чем на 50 символов
          nStart = IIf(.Parent.Start < 50, 0, .Parent.Start - 50)
          'Если конец найденного фрагмента отстоит от конца документа менее, чем на 50 символов
          nEnd = IIf(oDoc.Range.End - .Parent.End < 50, oDoc.Range.End, .Parent.End + 50)
     
          oNewDoc.Range.InsertAfter oDoc.Range(nStart, nEnd).Text
        Wend
      End With

  16. Андрей
    04.12.2009 в 20:38 | #16

    Извините, что может не по теме =(

    У меня проблема следующего характера, есть к примеру таблица с данными (номер договора(акта), Ф.И.О и тд), а также эти договора в .doc формате (к примеру 100 шт.), существуют ли такие флаги(якоря), которые можно расставлять по тексту(договора,акта) в соответствии с данными в таблице. Т.е. если я изменяю данные в таблице например ФИО, то эти данные меняються и в тех документах и местах в документах, где стоят эти так называемые флаги(якоря).

    Жду ответа!!!!

    Ответьте если сможете!!!

    Спасибо.

  17. 04.12.2009 в 20:56 | #17

    Андрей, специально для Вас сделано «Слияние»

    В каком Word'е вы работаете

  18. Андрей
    06.12.2009 в 12:44 | #18

    Спасибо огромное, за вашу отзывчивость и профессионализм, выручили так выручили. Еще раз спасибо.

  19. стас
    07.12.2009 в 11:32 | #19

    Предыдущий макрос был с ошибкой, это рабочий, но ищет не по всему документу. Что нужно сделать? Подскажите пожалуйста.

    Sub CopyText()
      Dim oDoc As Document 'Исходный документ
      Dim oNewDoc As Document 'Новый документ
      Dim sSearchString As String 'Строка поиска
      Dim nStart As Long, nEnd As Long 'Начало и конец текста, который нужно скопировать
      
      Set oDoc = ActiveDocument
      'Приглашение на ввод строки
      sSearchString = InputBox("Введите слово в поле:", "Поиск слов")
      'Если ничего не ввели или нажали «Отмена», то выходим из процедуры.
      If Len(sSearchString) = 0 Then Exit Sub
      Set oNewDoc = Documents.Add
      With oDoc.Range.Find
        .Text = sSearchString
        .Execute
           If .Found Then
          'Если начало найденного фрагмента отстоит от начала документа менее, чем на 50 символов
          nStart = IIf(.Parent.Start < 50, 0, .Parent.Start - 50)
          'Если конец найденного фрагмента отстоит от конца документа менее, чем на 50 символов
          nEnd = IIf(oDoc.Range.End - .Parent.End < 50, oDoc.Range.End, .Parent.End + 50)
           oNewDoc.Range.InsertAfter oDoc.Range(nStart, nEnd).Text
           End If
      End With
      Set oDoc = Nothing
      Set oNewDoc = Nothing
    End Sub

  20. 07.12.2009 в 20:57 | #20

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

  21. стас
    08.12.2009 в 09:52 | #21

    Александр спасибо за понимание, нашел свою ошибку, сейчас все работает как надо. Макрос написанный вами можно использовать телекоммуникации для отсева данных в трейсе. Еще раз СПАСИБО.

  22. Вождь
    02.01.2010 в 08:22 | #22

    Я написал макрос пакетной замены который использует стандартный диалог Word "Найти и заменить" и все его возможности. Ни в одном из предложенных макросов я такого не видел. См. http://alex-mail.at.tut.by

  23. Марк Розенберг
    02.01.2010 в 14:27 | #23

    Инженер-программист RAA, один из пользователей моего шаблона VolRepl Beta (http://volrepl.markros.ru), спросил меня, можно ли провести замену текста, находящегося в надписи, сгруппированной с др. объектами (линии, фигуры). А группа в свою очередь размещена в колонтитуле.

    В текущей версии шаблона VolRepl Beta такая возможность не предусмотрена, но в ходе переписки с RAA выяснилось, что для стоящей перед ним задачи интерактивная замена не нужна, достаточно выполнять замену в автоматическом режиме. Поэтому я решил порекомендовать ему макрос пакетной замены от Александра Витера. Однако выяснилось, что механизм навигации, использованный в этом макросе, не позволяет выполнять замену текста в расположенных в колонтитулах надписях, содержащихся в группе. Я внес в него необходимые исправления, и исправленный вариант предлагаю вашему вниманию. В этом варианте возможна автоматическая замена текста в надписях, фигурах и объектах WordArt, расположенных колонтитулах, даже если они находятся в группах и/или на полотне. В доступном для загрузке файле SrcAndRpl_Beta3_m1.rar (http://volrepl.markros.ru/SrcAndRpl_Beta3_m1.rar) (57 767 байт) сжат файл SrcAndRpl_Beta3_m1.doc (169 472 байта). Используйте на свой страх и риск.

  24. 12.01.2010 в 06:10 | #24

    Мне макрос очень понравился, спасибо автору.

  25. 12.01.2010 в 09:51 | #25

    На подходе следующая версия этого макроса с учётом замечаний Марка Розенберга. Будут представлены две версии: для Word 2003 и ниже и для Word 2007 и выше.

  26. Вождь
    13.01.2010 в 01:28 | #26

    Посмотрел макрос SrcAndRpl_Beta3_m1.rar.

    Для перебора всех частей документа (в т.ч. все надписи в группах и на полотне), могу посоветовать конструкцию попроще:

    Dim R As Word.Range
            ' части документа
            For Each R In srDoc.StoryRanges
                Do
                    ' ...обработка области R...
                    ' вложенные/следующие части
                    Set R = R.NextStoryRange
                Loop While Not (R Is Nothing)
            Next R

    В колонтитулах надписи не обрабатываются, придется извращаться.

    Например, так:

    Public Function Macro_TextFrameRun( _
        Optional ByRef tfRange As Word.Range = Nothing, _
        Optional ByRef tfMacro$ = "", _
        Optional ByRef orV2 As Variant, _
        Optional ByRef orV3 As Variant, _
        Optional ByRef orV4 As Variant, _
        Optional ByRef orV5 As Variant) As Long
    ' запустить макрос для надписей области
    ' tfRange - область с надписями (Nothing - главная часть)
    ' tfMacro - имя запускаемого макроса
    ' orV2-orV5 - параметры передаваемые макросу tfMacro
    ' возвращает количество успешных запусков макроса tfMacro
    ' !!! макрос tfMacro запускается командой:
    '     tfMacro(область текста надписи, orV2, orV3, orV4, orV5)
        Macro_TextFrameRun = 0
        'On Error Resume Next ' тест
        If Not Range_StoryIfEmpty(tfRange) Then Exit Function
        
    Dim S As Word.Shape, O As Word.Shape
        
        ' объекты области
        For Each S In tfRange.ShapeRange
            Select Case S.Type
                ' полотно
                Case msoCanvas: GoSub sub_Canvas
                ' группа
                Case msoGroup: GoSub sub_Group
                ' другие
                Case Else
                    Set O = S
                    GoSub sub_Run
            End Select
        Next S
        Exit Function
        
    sub_Canvas: ' объекты полотна S
    Dim CI As Word.Shape
        For Each CI In S.GroupItems
            If S.Type = msoGroup Then
                GoSub sub_Group
            Else
                Set O = CI
                GoSub sub_Run
            End If
        Next CI
        Return
        
    sub_Group: ' объекты группы S
    Dim GI As Word.Shape
        For Each GI In S.GroupItems
            Set O = GI
            GoSub sub_Run
        Next GI
        Return
        
    sub_Run: ' проверка и обработка объекта O
        ' наличие контейнера
        If O.TextFrame.HasText  True Then Return
        'On Error Resume Next ' тест
        Application.Run _
            MacroName:=tfMacro, _
            varg1:=O.TextFrame.TextRange, _
            varg2:=orV2, _
            varg3:=orV3, _
            varg4:=orV4, _
            varg5:=orV5
        If Err.Number = 0 Then _
            Macro_TextFrameRun = Macro_TextFrameRun + 1
        Return
        
    End Function

  27. 13.01.2010 в 09:36 | #27

    Спасибо за внимание к моей работе. В новой версии, которую я пообещал от имени Комментатор 5, надписи в колонтитулах обрабатываются

  28. курман
    21.02.2010 в 01:12 | #28

    Александр, спасибо за макрос он очень облегчает людям работу!

    у меня вопрос: хочу заменить ФОРМАТЫ, а не текст. такое возможно?

    допустим у меня во всех файлах заголовки начинаются вот в таком формате

    "обычный, шрифт 15 или 17, синий"

    а я хочу менять это все только на формат "заголовок 2"

    1. у меня все заголовки синего цвета. можно брать по цвету

    2. либо только первую строку во всех текстах поменять на заголовок 2, думаю это уже отдельная работа.

    6116402@gmail.com мой адрес. спасибо еще разок

  29. Марк Розенберг
    22.02.2010 в 11:56 | #29

    Курману. Посмотрите, может быть, вам подойдет мой шаблон VolRepl Beta (http://volrepl.markros.ru). Только в нем не предусмотрен для поиска размер шрифта (это не принципиальное ограничение, можно доработать, если очень нужно).

  30. Валерий
    16.03.2010 в 18:27 | #30

    Приходится работать с массой документов. Для окочательного однообразия оформление должно быть таким:

    Весь текст шрифтом TimesNew Roman

    Одинарный интервал

    Абзац 6 рт до и после ко всему документу, за исключением таблиц.

    Первая строка: 12 рт до, 3 рт - после, жирн;

    Вторая строка: 0;0, курсив.

    Третья строка:

    все ПРОПИСНЫЕ, жирн;

    12 pt - до, 12 pt - после

    и,

    это все для директории, в которой 250-300 файлов.

    Может кто подскажет прямой макрос. Заранне спасибо.

    Ответ на: ми-007"ьфшдюкг

  31. Александр
    02.04.2010 в 09:51 | #31

    Здравствуйте. Все здорово все нравится..., но у меня возникает ошибка при поиске и замене строки длиной более 255 символов...

    ругается Run-time error 5854, слишком длинный строковый параметр. Можно решить этот вопрос каким-нибудь способом?

  32. Марк Розенберг
    09.04.2010 в 19:06 | #32

    Ограничение в 255 символов заложено в диалоге Найти и заменить и в соответствующем методе VBA. В шаблоне VolRepl Beta для замены можно использовать любой фрагмент документа, но длина строки поиска ограничена.

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

    Я не стал этим заниматься, поскольку такая задача встречается редко.

  33. Евгений
    28.04.2010 в 18:58 | #33

    Здравствуйте, Марк! Все просто супер - экономите мне кучу времени на правке документов...

    Маленькое пожелание - можно в выводимом отчете указывать количество замен в каждом документе?

    Спасибо.

  34. Иван
    03.06.2010 в 23:02 | #34

    Добрый день! Не могли бы вы подсказать по следующей ситуации? Есть документ, который имеет вид:

    ====================

    фрагмент 1

    разнообразного

    текста

    ====================

    фрагмент 2

    разнообразного

    текста

    ====================

    и так далее

    необходимо в нем найти слово (или сочетание символов), затем удалить строку содержащую это слово, а также все строки выше и ниже в этом фрагменте, чтобы осталось только это:

    ====================

    ====================

    Заранее благодарю!!!

  35. Павел Полухин
    12.08.2010 в 10:24 | #35

    И так если надо заменить последовательность символов которая меньше 255 символов, на последовательность более 255 символов сделал такой макрос, может кому и пригодится.

    Sub ReplaceInRange(rRange, sFind, sReplace)
        CopyLen = 255 - Len(sFind)
        tmp = sReplace
        If Len(tmp) > CopyLen Then
            While Len(tmp)  0
                tmpReplace = Mid(tmp, 1, CopyLen)
                tmp = Replace(tmp, tmpReplace, "")
                rRange.Find.Execute FindText:=sFind, _
                    ReplaceWith:=tmpReplace + sFind, Replace:=wdReplaceAll
            Wend
        End If
        rRange.Find.Execute FindText:=sFind, _
            ReplaceWith:=tmp, Replace:=wdReplaceAll
    End Sub

  36. Леонид
    10.10.2010 в 11:12 | #36

    Марк и Александр, огромное спасибо! Ваши макросы, в особенности VolRepl Beta (http://volrepl.markros.ru) - экономят массу времени...

    Правда, одну проблему я так и не поборол пока. Можно спросить?

    Есть .DOC-файл, в котором около тысячи картинок, вставленных в него через "Вставить -> Рисунок -> Из файла -> Связать с файлом". То есть картинки в DOC-файле не хранятся, а находятся в отдельной папке \Images, и все подключены через "Правка\Связи...". Можно ли осуществить поиск этих всех картинок в тексте и замену каждой картинки на текстовую строку вида

    {bmc Images/image_01_name.bmp}, {bmc Images/image_02_name.bmp} и т.д. ?

  37. Леонид
    10.10.2010 в 12:17 | #37

    Да, забыл сказать. Word2003. Rартинки - все BMP и PNG, но будут впоследствии преобразованы только в BMP. Впоследствии, Adobe Robohelp (8.0) for Word на основании имеющегося в моём DOC-файле текста и записей вида {bmc Images/реальное_имя картинки_в_папке.bmp} создаёт HTML help (связанный набор HTML файлов) по заданному мной шаблону. Алгоритм поиска картинок и их замены на {bmc Images/Images/реальное_имя картинки_в_папке.bmp} в Robohelp присутствует. В виде макроса под названием ConvertDocument. Но доступ к этому макросу для пользователей Robohelp запрещён, а набор его возможностей крайне ограничен... В частности, именно этот нехороший макрос ВСЕ повторяющиеся картинки из папки, связанные с DOC-файлом, заменяет сперва на {bmc Images/реальное_имя картинки_в_папке.bmp} (первое вхождение), а затем (если в DOC-файле картинка привязана второй, третий, N-ный раз) - присваивает им имена своим автонумератором - {bmc IMG00001.bmp}, {bmc IMG00002.bmp}, {bmc IMG00003.bmp} и т.д., в порядке следования картинки в тексте... После этого, понять какая картинка была откуда, крайне сложно... Надо сказать, что макрос ConvertDocument в Robohelp - многофункциональный. Параллельно с поиском-заменой по телу DOC-файла, он ещё и создаёт в папке Images/ новые картинки в формате BMP (если оригинальный связанный файл был в ином, нежели BMP, формате). Правда, в не очень высоком разрешении, в каком - одному Robohelp понятно, но это разрешение ВСЕГДА ниже чем у оригинальных файлов. Все эти BMP картинки (как {bmc Images/реальное_имя картинки_в_папке.bmp}, так и автонумерованные) - потом точно в таком же виде, с теми же именами, в виде JPG или GIF файлов (это уже пользователь решает), будут использованы в HTML-help'е. Самое неприятное, что иногда (непонятно почему?) макрос ConvertDocument от Adobe Robohelp, вообще тупит - запись {bmc Images/реальное_имя картинки_в_папке.bmp} или {bmc IMG00001.bmp} ВООБЩЕ НЕ ПОЯВЛЯЕТСЯ в теле документа...

    Теперь наверное понятно, зачем мне понадобился подобный макрос?

    1) если одинаковые связанные картинки встречаются неоднократно в теле документа, неуправляемый макрос Robohelp'а включает очень неудобную автонумерацию. Когда картинок много, ручная замена их имён с {bmc IMG0000N.bmp} на {bmc Images/реальное_имя картинки_в_папке.bmp} впоследствии очень трудоёмка.

    2) Имея подобный макрос, достаточно самому проследить, чтобы в папке Images находились только BMP-файлы, нужного размера и разрешения, имеющие понятное имя... Записи об этом в виде {bmc Images/реальное_имя картинки_в_папке.bmp} уже будут созданы.

    Возможно я кого-то озадачил таким длинным постом, извините! Заранее благодарен, если уважаемые авторы проекта мне что-то посоветуют в этом направлении. Кстати, подобная моей проблема обсужждалась другими людьми на сайте Adobe, но - как видим - на текущий момент не разрешена: http://forums.adobe.com/message/2428453

  38. Леонид
    11.10.2010 в 14:17 | #38

    В общем, пока решил свою задачку так:

    Сперва выполняю перебор InlineShapes и перед каждым из найденных объектов, записываю нужную текстовую строку.

    Вот такой код (за основу я взял Example2 на http://markros.ru/graphics/ ) :

    Воспользовался там же процедурой CountInShps.

    Шаг1.

    Sub FindAndReplaceAllInlineShapes()
    'Пример: перебор объектов InlineShape в цепочках документа
    'Вычисляется число объектов InlineShape в цепочках документа
    'Объекты InlineShape в надписях, расположенных в колонтитулах,
    'не учитываются, поскольку не содержатся в цепочках
    'Перед найденными объектами InlineShape записывается строка вида {bmc 'SourceFileFullName'}
    'Найденные объекты InlineShape удаляются
      Dim intInlShpCount As Integer 'Счетчик InlineStory
      Dim rngStory As Range 'range для текущей цепочки в цикле
      Dim inlShape As InlineShape 'текущий объект InlineShape в цикле
      intInlShpCount = 0
      'Цикл по каждому типу цепочек активного документа
      For Each rngStory In ActiveDocument.StoryRanges
        'цикл по всем цепочкам одинакового типа
        Do
          'в диапазоне цепочки rngStory на каждой итерации
            For Each inlShape In rngStory.InlineShapes
    inlShape.Range.InsertBefore ("{bmc " & inlShape.LinkFormat.SourceFullName & "}")
              intInlShpCount = intInlShpCount + 1
            Next inlShape
          'переход к следующей цепочке rngStory того же типа
          Set rngStory = rngStory.NextStoryRange
        Loop Until rngStory Is Nothing
      Next rngStory
      MsgBox "Всего заменено объектов InlineShape: " & intInlShpCount, vbInformation, "Перебор объектов InlineShape во всех цепочках"
    End Sub

    Затем - просто удаляю все объекты типа InlineShape (т.к. они теперь уже не нужны).

    Шаг2.

    Sub delAllinlShapes()
    Dim inlShape As InlineShape
    For Each inlShape In ActiveDocument.Range.InlineShapes
       inlShape.Delete
    Next
    End Sub

    Возможно, не совсем оптимальное решение - но оно работает.

    Ещё раз, благодарю Вас, Марк Розенберг, за Ваши чрезвычайно полезные разработки!

  39. 24.11.2010 в 11:18 | #39

    Да, это все здорово, особенно когда количество документов переваливает за сотню. Поэтому все авторам - респектsmile Но обычно требуется замена в 2-10 документах. Для этого вовсе не обязательно использовать сторонние средства, а само решение весьма банально:

    + Выделяем и открываем все документы, в которых требуется произвести замену.

    + В последней открывшемся документе нажимаем Ctrl+H - появится стандартное диалоговое окно поиска и замены, в нем задаем все необходимые условия.

    + Нажимаем Заменить все для замены в текущем документе. Сохраняем и закрываем документ, не закрывая (!) при этом окно поиска и замены, после чего переключаемся на следующий окрытый документ (Ctrl+F6).

    + В следующем документе для нас уже отображено предыдущее диалоговое окно поиска и замены со всем заданными условиями - остается только нажать Заменить все.

    + ...

    PS. Хочу подчеркнуть, что стандартный механизм поиска и замены в Word достаточно мощный (например, использование подстановочных символов и поиска по стилями/форматам может значительно сократить трудозатраты), поэтому использование сторонних средств и макросов не всегда оправдано.

  40. Аня
    14.12.2010 в 11:21 | #40

    Здравствуйте!

    Спасибо большое за отличный макрос!

    После долгих поисков нашла почти то, что нужно. Правда, мне очень необходим счетчик количества сделанных замен (а точнее, замены и не нужны, требуется просто посчитать слова). В обсуждении промелькнула информация о сделанном "усовершенствовании" макроса с наличием счетчика, но ссылка не сохранилась. Если бы кто-нибудь смог мне помочь, это было бы очень здорово!

    Спасибо,

    Аня.

    почта ann.korobkova собака мэйл ру

  41. ЧеКа
    18.05.2011 в 15:36 | #41

    Помогите, я в макросах полный ноль.

    Проблема в том, что не могу заменить ссылки в документах (.doc .docx).

    Укажите, пожалуйста, где я делаю ошибку:

    1. Указываю папку

    2. В таблице пишу слева "lkjl@sdf.ru" и справа "oip@pio.ua"

    3. Нажимаю пуск, ставлю галку на "изменять гиперссылки".

    Программа все делает без сбоев, вроде как заменяет, в логе прописаны все замененные файлы. Но когда открываю файл - старая ссылка на месте.

    Может я чего не знаю, или с ссылками нужно поступать как-то иначе?

  42. 19.05.2011 в 05:13 | #42

    ЧеКа, пришлите мне документ на почтовый ящик viter.alex@gmail.com и я проверю, что не срабатывает. Правда, только в воскресенье, не раньше.

  43. ЧеКа
    19.05.2011 в 17:26 | #43

    Спасибо за оперативный ответ.

    Не совсем понял, какой документ присылать. Если имеется в виду документ, содержащий макрос, то пришлю (хотя там ведь ничего не менялось вроде как - смысл?).

    Если Вы имели в виду документы, по которым ведется поиск - так таких документов тысячи. Но для примера могу выслать пару, если это поможет.

    Заранее спасибо за помощь.

  44. 20.05.2011 в 11:33 | #44

    Конечно, пришлите пример документа, по которому ведётся поиск.

  45. ЧеКа
    23.05.2011 в 09:56 | #45

    Все выслал перед выходными (19.05).

    После перезагрузки (точнее уже сегодня, в понедельник) обнаружил, что ссылки поменялись, только криво: явная ссылка krasn-osv@rambler.ru поменялось на поле {HYPERLINK "mailto:osvitakr@ukr.net"}.

    При этом копируется это поле как текст krasn-osv@rambler.ru (то есть при попытке вставить его сюда выдало прежний адрес).

    Есть два предположения: 1. при установке офиса я не установила какой-то нужный для работы макроса компонент. 2. Эта проблема касается почтовых ссылок (может у них свои заморочки?)

    Извините, если мои предположения - бред. Это от полного незнания материала.

    Может, существует более простая возможность поменять эту злополучную ссылку на обычный текст? Для данной ситуации меня бы такой вариант устроил...

  46. ЧеКа
    01.06.2011 в 21:56 | #46

    Нашлось ли какое-нибудь решение описанной проблемы?

  47. 02.07.2011 в 18:12 | #47

    Спасибо

  48. Александр
    16.07.2011 в 17:21 | #48

    Очень нужный макрос.

    Только у меня установлен Word 2010 x64 и как только нажимаешь кнопку "Пуск" выпадает сообщение об ошибке. Просит обновить макрос под х64.

    Может быть можно как-то исправить эту проблему?

  49. Саша
    19.11.2011 в 16:24 | #49

    Шикарно, спасибо, спасли огромную кучу времени.

  50. 1
    23.01.2012 в 13:10 | #50

    Большое спасибо!

  51. SergN
    25.04.2012 в 14:44 | #51

    Спасибо, он РАБОТАЕТ!

    3 часа работы руками и всего 5 минут на оставшейся объем после запуска макроса.

    Красота!

    Огромное спасибо!

  52. swan
    07.06.2012 в 13:30 | #52

    Коллегит на 2010 64х не пашет .. что поправить ?

  53. Анна
    13.06.2012 в 11:31 | #53

    Очень нужно на 64-ку!

  54. Аноним
    09.07.2012 в 10:53 | #54

    Добрый день!

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

    1. Есть ли возможность делать замену не с помощью стандартного "поиск и замена", а напрямую из макроса?

    2. Можно ли делать замену сразу по всем блокам?

    Сейчас макрос у меня пробегает более 400 строк таблички, и для каждой строки перебирает 100 блоков... очень долго получается.

    * а прогресс-бар надо у вас позаимствовать ))

    если кто знает ответ на мои вопросы - напишите на megadrifter (sobaka) gmail.com пожалуйста.

  55. Маша
    11.07.2012 в 15:00 | #55

    А скажите пожалуйста "чайнику" как нажать в SrcAndRpl_Beta3.doc кнопки "Пуск" и "Выбрать папку"???? и можно ли сделать изменения в документах в одной папке, в которой находятся ещё много папок, а в них и находятся эти документы, в которых надо сделать изменения????? Пожалуйста помогите!!! Надо очень срочно сделать изменения во многих доках, физически ничего не успеваю!!! Спасибо всем за отклик!!!!

  56. Аноним
    27.07.2012 в 11:14 | #56

    Макрос работает хорошо, все что необходимо выполнил. Единственное, макрос тормозил на файлах которые попали под маску и находятся в "захваченном" состоянии (к ним нет доступа) речь едет о файлах ~$хххх.doc. Желательно сделать проверку на доступность файла при открытии.

  57. Артём
    27.07.2012 в 13:50 | #57

    Да на 32-ух битной винде работает превосходно скрипт, а вот с 64-ех реально проблемы. Я так понял в начале там подключается 32-ух битная библиотека (или что то такое). с префиксом _32

    Думаю многие пользватели скажут спасибо, если автор сможет сделать версию и для 64-ех битного Word

  58. Спасибо
    14.11.2012 в 18:52 | #58

    Спасибо! Очень полезная штука.

    Сделал все, что хотел: "найти и заменить в нескольких файлах *.doc*".

    Заменяет слово или список слов во всех файлах, находящихся в одной указанной папке.

    Заменять выражения пока не пробовал.

    Супер!

  59. Павел
    12.12.2012 в 17:10 | #59

    Здравствуйте. Пытался заменить словосочетания в документе Word с помощью VolRepl и SrcAndRpl_Beta3. Большое предложение разбивал на несколько частей. часть словосочетаний меняется часть нет. Что может быть причиной.

  60. Алексей
    20.02.2013 в 00:56 | #60

    а) Не хватает подробной информации в логе: сколько замен сделано, сколько и каких строк найдено.

    б) Нужен то ли запрос нf запись итогового файла, то ли предусмотреть бэкап.

    в) Хотелось бы поиска/замены с использованием регулярных выражений: например, мне надо не просто найти строки, а убить их, не оставляя пустых абзацев. Найти строки и заменить на них же, но с добавлением своей строки. Найти и заменить формат. Ну и всё остальное, что может показаться "бешенством с жиру".

    А в предложенном варианте работает как зверь. Автору респект!

    Ожидается ли появление в макросе выше перечисленных возможностей ?

    Возможно ли сделать замену символа из греческого на букву русского алфавита ?

  61. Max
    07.10.2013 в 06:22 | #61

    Всем Салют! smile Сперва хочется поблагодарить автора за столь полезную и незаменимую в работе вещь! Спасибо мужик)

    Но у меня возник мучительный вопрос...

    во втором пункте (где надо забивать заменяемый текст) можно ли как то использовать несколько строк заменяего текста.. к примеру:

    Искать текст Заменить на текст:

    1)Адрес: Шишкина ул., д. 18 1)Адрес: Братеевская ул., д. 105

    2)Центр образования № 108 2) Гимназия 1005

    можно ли проделать этот трюк столбиком , чтобы мне не пришлось создавать несколько макросов на каждое заменяемое слово?

    хочется сделать РЫБУ по умолчанию из определенных слов, которые я заменял бы в столбце на то что нужно

  62. Аноним
    29.11.2013 в 06:16 | #62

    Здраствуйте! спасибо Вам за такой макрос, но у меня такая ошибка, я пытаюсь в выбраных документах заменить выбраный текст, на большой текст, и мне пишет ошибка, слишком долгий текстовый формат. Подскажите как справиться с этой ошибкой. Заранее спасибо

  63. Аноним
    17.01.2014 в 10:22 | #63

    Добрый день. Большое спасибо за макрос, очень полезная вещь! но обнаружилась такая проблема: делаю замену в файлах *.dot, внизу каждой страницы добавляются колонтитулы, из-за чего нарушается структура документов и всё равно приходится их потом доводить до ума вручную

  64. Аноним
    31.03.2014 в 12:04 | #64

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

  65. Алексей
    19.05.2014 в 10:55 | #65

    Макрос крайне полезный, но у меня тут же ругнулся на то, что у меня 64-битная система

  66. volna
    03.03.2015 в 18:42 | #66

    Спасибо Александру Витеру за макрос по замене в док-ах Word. Но почему-то невозможно выбрать путь, а также что на что меняем. Путь пришлось создать такой как по умолчанию. В файле отчета написано что заменено слово testdone на test. В моих файлах файлах слово testdone отсутствовало, но когда я его туда вписал, то замена была выполнена. Что надо сделать, чтобы путь и слова можно было бы выбирать из окна запущенного макроса. Я сделал скрин, но куда отправить?

  67. Игорь
    19.11.2015 в 12:28 | #67

    Чтобы работало на 64-битной системе нужно изменить строчку

    Private Declare Function GetTickCount Lib "kernel32" () As Long

    на

    Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long

    Но в колонтитулах так и не ищёт, если кто-то поделится версией, которая обрабатывает колонтитулы, буду благодарен, а то все ссылки не рабочие.

  68. Дмитрий
    27.10.2016 в 09:39 | #68

    Спасибо Александр за макрос. Необходимо заменить 3 абзаца на 1. Ошибка run time error 5854. Можно ли е обойти?

  69. Melx
    14.12.2016 в 11:17 | #69

    В дополнение к комментарию №67 http://wordexpert.ru/page/makros-paketnoj-zameny-ot-aleksandra-vitera#comment-7095.

    Для универсальности кода в части 64х/32х битной системы и Office 2010-2013/Office 20103-2007

    нужно изменить строчку

    Private Declare Function GetTickCount Lib "kernel32" () As Long

    на

    #If VBA7 Then ' Office 2010-2013

    Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As LongPtr

    #Else ' Office 2003-2007

    Private Declare Function GetTickCount Lib "kernel32" () As Long

    #End If

    а также

    Dim nTimeCntr As Long 'Счетчик времени обработки

    на

    Dim nTimeCntr As LongPtr 'Счетчик времени обработки

  70. Victor
    26.01.2017 в 04:11 | #70

    Добрый день!

    Есть ли возможность перед словом вставить рисунок. В смысле в нескольких сотнях документов. Если есть - подскажите, если нет - тоже скажите.

    С уважением..

  71. Yfnfkmz
    31.03.2017 в 16:34 | #71

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

  72. Mr. Al
    24.08.2017 в 09:14 | #72

    Спасибо за макрос, очень интересная и полезная вещь!

    Не знаю, нужны ли автору сообщения об ошибках, но вот, извольте smile

    Как известно в Word'e можно ставить пробел, удерживая ctrl+shift. В таком случае следующее слово не перенесется на следующую строку или перенесется вместе с предыдущим. Эта функция довольно часто используется в документах, например, чтобы инициалы человека не переносились отдельно от фамилии.

    Так вот, при тестировании макроса обнаружил, что макрос не производит замену, если в предложении есть такие пробелы, при чем независимо от параметров (формата) вставки.

    Да, кстати, поддерживаю предыдущих комментаторов насчет ограничения по длине текста. Весьма хотелось бы заменять большие куски текста.

  73. 17.11.2017 в 11:06 | #73

    Работает на удивление отлично. Есть один непонятный момент: если меняется часть текста, в которой первая половина жирным шрифтом, а вторая - обычным, то итог замены получается весь жирным. Может, я что-то не так делаю?

  74. Влад
    06.05.2018 в 16:12 | #74

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

  75. Alex
    19.09.2018 в 17:35 | #75

    Добрый Вечер!

    А можно сделать так, чтобы измененый файл сохранялся отдельно а файл который был открыть оставался неизменным?

  76. Plagron
    26.09.2018 в 15:11 | #76

    http://wordexpert.ru/page/makros-paketnoj-zameny-ot-aleksandra-vitera#comment-6582

    Подтверждаю проблему с добавлением колонтитулов и в итоге меняется структура

  77. Никита
    17.04.2019 в 14:42 | #77

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

    Спасибо

  78. Максим
    06.09.2019 в 20:13 | #78

    Код для работы 32/64. Нашел в гугле. Работает

    #If Win64 Then

    Private Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long

    #Else

    Private Declare Function GetTickCount Lib "kernel32"() As Long

    #End If

  79. Лера
    13.10.2020 в 16:35 | #79

    Вы гений!!!!!!Офигенно!!!!!!!

  80. Олег
    24.02.2021 в 18:08 | #80

    Александр!

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

    Он позволил сэкономить массу времени.

    Здоровья Вам и удачи во всём!

  81. Паша
    09.06.2021 в 17:38 | #81

    Раньше пользовался, было хорошо. Но сейчас очень пахабит файлы (то ли винда 10 виновата, то ли новый ворд, не знаю).

  82. Андрей
    25.08.2021 в 12:15 | #82

    Спасибо. Очень полезная штука!

    Маленький баг - колонтитулы в исправленных документах отодвигает, поэтому текст смещается.

  83. Григорий
    23.09.2021 в 17:53 | #83

    Автору спасибо за данный труд!!!

  84. masterufa
    16.11.2021 в 10:24 | #84

    Добрый день. Макрос очень полезный. Вопрос: можно преобразовать макрос так, чтобы он открывал файлы ВОРД в одной папке и сохранял их как ПДФ ?

    То есть начало такое же:

    1. в файле ВОРД выбирается путь к папке;

    2. при нажатии на кнопку "Пуск" выполняется следующий макрос:

    Sub ConvertWordsToPdfs()

    Dim xIndex As String

    Dim xDlg As FileDialog

    Dim xFolder As Variant

    Dim xNewName As String

    Dim xFileName As String

    Set xDlg = Application.FileDialog(msoFileDialogFolderPicker)

    If xDlg.Show -1 Then Exit Sub

    xFolder = xDlg.SelectedItems(1) + "\"

    xFileName = Dir(xFolder & "*.*", vbNormal)

    While xFileName ""

    If ((Right(xFileName, 4)) ".doc" Or Right(xFileName, 4) ".docx") Then

    xIndex = InStr(xFileName, ".") + 1

    xNewName = Replace(xFileName, Mid(xFileName, xIndex), "pdf")

    Documents.Open FileName:=xFolder & xFileName, _

    ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _

    PasswordDocument:="", PasswordTemplate:="", Revert:=False, _

    WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _

    wdOpenFormatAuto, XMLTransform:=""

    ActiveDocument.ExportAsFixedFormat OutputFileName:=xFolder & xNewName, _

    ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _

    wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _

    Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _

    CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _

    BitmapMissingFonts:=True, UseISO19005_1:=False

    ActiveDocument.Close

    End If

    xFileName = Dir()

    Wend

    End Sub

  85. Евгений
    11.02.2022 в 09:24 | #85

    Огромная благодарность автору за невероятную экономию времени, а Максиму за подсказку про Win 64

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

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

^ Наверх