1

Тема: Макрос для замены содержимого ссылок

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

В тексте документа Word есть ссылки на содержимое текстовых полей.

Подскажите, пожалуйста, макрос для удаления ссылок и замены их на содержимое текстовых полей, то есть для замены ссылок вида {REF ТекстовоеПоле1 \h} на значения ТекстовоеПоле1.

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

2

Re: Макрос для замены содержимого ссылок

Вот макрос для преобразования всех полей REF в обычный текст
(сильно урезанная версия из моего шаблона).

Sub ПреобразоватьПерекрестныеСсылкиВОбычныйТекст()
' Преобразование полей REF в обычный текст

    Call ПреобразоватьПолеВТекст("^d REF") ' преобразуем REF
    Call ОчисткаПоиска ' очищаем поиск

End Sub

Sub ПреобразоватьПолеВТекст(strText)
' Преобразование полей определенного типа в обычный текст
' вход: текст для поиска, типа strText = "^d REF"

    ActiveWindow.View.ShowFieldCodes = True
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = strText ' текст для поиска
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    If Selection.Find.Execute = True Then
        Selection.Fields.Unlink
        Selection.MoveRight Unit:=wdCharacter, Count:=1
    End If
    Do Until Selection.Find.Execute = False
        Selection.Fields.Unlink
        Selection.MoveRight Unit:=wdCharacter, Count:=1
    Loop
    ActiveWindow.View.ShowFieldCodes = False
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
End Sub

Sub ОчисткаПоиска()
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "" ' ищем ничего
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
End Sub
Мой шаблон/макросы для автоматической нумерации Word 2003, 2007, 2010 и т.д. (стили, названия, перекрестные ссылки, LISTNUM). Делюсь: http://vk.com/club_alex_bir

3

Re: Макрос для замены содержимого ссылок

Александр Б. пишет:

Вот макрос для преобразования всех полей REF в обычный текст
(сильно урезанная версия из моего шаблона).
....

Код можно значительно сократить, если не пользоваться поиском и заменой, а работать непосредственно с полями Fields:

Sub Fields_REF_Unlink()
'Макрос обновления и последующей замены полей REF их значениями
'
    Dim myField As Field
    Dim i As Long
    i = ActiveDocument.Range.Fields.Count
    If i >= 1 Then
    Set myField = ActiveDocument.Fields(i)
'Чтобы избежать ошибок,
'элементы коллекции удаляем в обратном порядке, начиная с последнего
        Do
            If myField.Type = wdFieldRef Then
            myField.Update 'Обновляем поле. Если не требуется предварительное обновление
                                  'полей, то закомментировать или удалить эту строку
            myField.Unlink
            End If
            i = i - 1
            If i < 1 Then Exit Do  'выходим из цикла, когда все поля обработаны
            Set myField = ActiveDocument.Fields(i)
        Loop
    End If
    Set myField = Nothing
End Sub 

4

Re: Макрос для замены содержимого ссылок

Борис, вы меня опередили )
Я как раз обновлял шаблон, и хотел тут поместить исправление, что поиск надо выполнять назад, иначе поля LISTNUM будут преобразовываться неправильно!

В моем варианте, в одной процедуре нужно такое исправление (две новых сточки):

Sub ПреобразоватьПолеВТекст(strText)
' Преобразование полей определенного типа в обычный текст
' вход: текст для поиска, типа strText = "^d REF"

    Selection.EndKey Unit:=wdStory ' переходим в конец документа, иначе LISTNUM не преобразовать!

    ActiveWindow.View.ShowFieldCodes = True
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = strText ' текст для поиска
        .Replacement.Text = ""
        .Forward = False ' надо поиск делать назад, иначе LISTNUM не преобразовать!
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    If Selection.Find.Execute = True Then
        Selection.Fields.Unlink
        Selection.MoveRight Unit:=wdCharacter, Count:=1
    End If
    Do Until Selection.Find.Execute = False
        Selection.Fields.Unlink
        Selection.MoveRight Unit:=wdCharacter, Count:=1
    Loop
    ActiveWindow.View.ShowFieldCodes = False
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
End Sub
Мой шаблон/макросы для автоматической нумерации Word 2003, 2007, 2010 и т.д. (стили, названия, перекрестные ссылки, LISTNUM). Делюсь: http://vk.com/club_alex_bir

5

Re: Макрос для замены содержимого ссылок

Разумеется для преобразования полей разных типов нужно писать в главной процедуре:

Call ПреобразоватьПолеВТекст("^d REF") ' преобразуем REF
Call ПреобразоватьПолеВТекст("^d SEQ") ' преобразуем SEQ
Call ПреобразоватьПолеВТекст("^d STYLEREF") ' преобразуем STYLEREF
Call ПреобразоватьПолеВТекст("^d LISTNUM") ' преобразуем LISTNUM
Мой шаблон/макросы для автоматической нумерации Word 2003, 2007, 2010 и т.д. (стили, названия, перекрестные ссылки, LISTNUM). Делюсь: http://vk.com/club_alex_bir

6

Re: Макрос для замены содержимого ссылок

Александр  Б, проверьте, может быть пригодится.
Когда тестировал свой код, то обнаружил странную вещь.
Если перед строкой  myField.Unlink стоит строка myField.Update, то скорость выполнения кода значительно увеличивается по сравнению со случаем, когда строка myField.Update отсутствует.
Т.е. имеем парадокс: добавление лишней операции - обновление поля непосредственно перед разрывом связи - увеличивает скорость выполнения метода Unlink (причем очень сильно).

7

Re: Макрос для замены содержимого ссылок

Вот, наверно, самый лучший и короткий код для того, чтобы превратить все перекрестные ссылки (поля REF) в обычный текст:

Sub UnLinkRefFields()
Dim i As Integer
    With ActiveDocument
        For i = .Fields.Count To 1 Step -1
            With .Fields(i)
              If .Type = wdFieldRef Then .Unlink
            End With
        Next
    End With
End Sub
Мой шаблон/макросы для автоматической нумерации Word 2003, 2007, 2010 и т.д. (стили, названия, перекрестные ссылки, LISTNUM). Делюсь: http://vk.com/club_alex_bir

8

Re: Макрос для замены содержимого ссылок

Проверю, если не поленюсь )

Мой шаблон/макросы для автоматической нумерации Word 2003, 2007, 2010 и т.д. (стили, названия, перекрестные ссылки, LISTNUM). Делюсь: http://vk.com/club_alex_bir

9

Re: Макрос для замены содержимого ссылок

По-моему .Update ничего не ускоряет...
Проверял на двух процедурах ниже:

Sub UnLinkRefFields()
Dim i As Integer
    With ActiveDocument
        For i = .Fields.Count To 1 Step -1
            With .Fields(i)
                If .Type = wdFieldRef Then
                    .Unlink
                End If
            End With
        Next
    End With
End Sub

Sub UpdateAndUnLinkRefFields()
Dim i As Integer
    With ActiveDocument
        For i = .Fields.Count To 1 Step -1
            With .Fields(i)
                If .Type = wdFieldRef Then
                    .Update
                    .Unlink
                End If
            End With
        Next
    End With
End Sub
Мой шаблон/макросы для автоматической нумерации Word 2003, 2007, 2010 и т.д. (стили, названия, перекрестные ссылки, LISTNUM). Делюсь: http://vk.com/club_alex_bir

10

Re: Макрос для замены содержимого ссылок

Перезагрузил компьютер, вновь открыл тестовый пример и... действительно, разницы в скорости выполнения не заметил sad .
Видимо был какой то глюк у компьютера во время отладки макроса.