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

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

[Ссылки на статью]

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

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

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

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

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

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

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

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

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

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

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

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

Макрос пакетной замены - 2

Это может пригодиться:

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

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

Добрый день!

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

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

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

С уважением, Николай
Николай
25.09.2009 в 16:14 | #2

Николай, вопросы (и ответы) публикую на сайте я сам. А задать их вы можете через наш Форум.
Игорь
08.10.2009 в 09:31 | #3

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

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

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

А в предложенном варианте работает как зверь. Автору респект!
Ольга
13.10.2009 в 22:15 | #4

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

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

Ещё раз спасибо.
Александр Витер
14.10.2009 в 08:24 | #5

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

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

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

Регулярные выражения стоят у меня в TODOlist, но не доходят руки
Рамиль
12.11.2009 в 21:25 | #6

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Обилие комментариев в исходном коде - очень помогло.
стас
27.11.2009 в 12:36 | #7

Может я не совсем по теме, но подскажите можно ли написать такой макрос, который находит фрагмент текста и копирует его в новый файл, и в месте с фрагментом копирует символов 50 вверх и вниз от фрагмента. Это возможно?
Николай
27.11.2009 в 13:49 | #8

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

Александр Витер

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

стас

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

Александр Витер
01.12.2009 в 21:14 | #11

Поясните подробнее, что нужно сделать.
стас
02.12.2009 в 10:14 | #12

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

Ваш макрос работает отлично, но нужно чтобы данные не выделялись вручную , а вводились и искались автоматически, с копированием в новый документ.
Александр Витер
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
```

стас

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

Александр Витер

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

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

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

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

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

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

Спасибо.
Александр Витер
04.12.2009 в 20:56 | #17

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

В каком Word'е вы работаете
Андрей
06.12.2009 в 12:44 | #18

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

стас

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

Александр Витер
07.12.2009 в 20:57 | #20

стас, я же уже сказал, что нужно изменить в предыдущем ответе на Ваш вопрос
стас
08.12.2009 в 09:52 | #21

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

Я написал макрос пакетной замены который использует стандартный диалог Word "Найти и заменить" и все его возможности. Ни в одном из предложенных макросов я такого не видел. См. http://alex-mail.at.tut.by
Марк Розенберг
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 байта). Используйте на свой страх и риск.
АндрейRus
12.01.2010 в 06:10 | #24

Мне макрос очень понравился, спасибо автору.
Комментатор 5
12.01.2010 в 09:51 | #25

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

Вождь

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

Александр Витер
13.01.2010 в 09:36 | #27

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

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

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

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

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

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

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

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

6116402@gmail.com мой адрес. спасибо еще разок
Марк Розенберг
22.02.2010 в 11:56 | #29

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

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

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

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

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

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

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

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

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

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

и,

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

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

Ответ на: ми-007"ьфшдюкг
Александр
02.04.2010 в 09:51 | #31

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

ругается Run-time error 5854, слишком длинный строковый параметр. Можно решить этот вопрос каким-нибудь способом?
Марк Розенберг
09.04.2010 в 19:06 | #32

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

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

Я не стал этим заниматься, поскольку такая задача встречается редко.
Евгений
28.04.2010 в 18:58 | #33

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

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

Спасибо.
Иван
03.06.2010 в 23:02 | #34

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

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

фрагмент 1

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

текста

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

фрагмент 2

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

текста

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

и так далее

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

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

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

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

Павел Полухин

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

Леонид
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} и т.д. ?
Леонид
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

Леонид

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

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

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

jarslav
24.11.2010 в 11:18 | #39

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

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

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

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

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

+ ...

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

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

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

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

Спасибо,

Аня.

почта ann.korobkova собака мэйл ру
ЧеКа
18.05.2011 в 15:36 | #41

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

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

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

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

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

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

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

Может я чего не знаю, или с ссылками нужно поступать как-то иначе?
Александр Витер
19.05.2011 в 05:13 | #42

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

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

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

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

Заранее спасибо за помощь.
Александр Витер
20.05.2011 в 11:33 | #44

Конечно, пришлите пример документа, по которому ведётся поиск.
ЧеКа
23.05.2011 в 09:56 | #45

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

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

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

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

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

Может, существует более простая возможность поменять эту злополучную ссылку на обычный текст? Для данной ситуации меня бы такой вариант устроил...
ЧеКа
01.06.2011 в 21:56 | #46

Нашлось ли какое-нибудь решение описанной проблемы?
Алексей Навныко
02.07.2011 в 18:12 | #47

Спасибо
Александр
16.07.2011 в 17:21 | #48

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

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

Может быть можно как-то исправить эту проблему?
Саша
19.11.2011 в 16:24 | #49

Шикарно, спасибо, спасли огромную кучу времени.
1
23.01.2012 в 13:10 | #50

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

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

Гость

Ваше имя:

Комментатор / хотите им стать

E-mail:
Пароль:

Чтобы стать комментатором введите email и пароль. Напишите комментарий. В дальнейшем ваша связка email-пароль, позволит вам комментировать и редактировать свои данные. Не забудьте про активацию (инструкция придет на ящик, указанный при регистрации).

Ваш комментарий

Введите нижние символы

Защита от спама: введите только нижние символы

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

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

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

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

Это может пригодиться:

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

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

Сообщение: “Не удается зарегистрировать данный документ”

Как вставить галочку (флажок) в текст документа

Стили списков в редакторе Word 2003

Быстрое создание нового документа на основе шаблона

Автотекст и Word 2007

страницы

авторство

контакты

ваше имя
e-mail
сообщение: