Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
Здравствуйте!
В тексте документа Word есть ссылки на содержимое текстовых полей.
Подскажите, пожалуйста, макрос для удаления ссылок и замены их на содержимое текстовых полей, то есть для замены ссылок вида {REF ТекстовоеПоле1 \h} на значения ТекстовоеПоле1.
Заранее благодарен!
Вот макрос для преобразования всех полей 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Вот макрос для преобразования всех полей 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 Борис, вы меня опередили )
Я как раз обновлял шаблон, и хотел тут поместить исправление, что поиск надо выполнять назад, иначе поля 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Разумеется для преобразования полей разных типов нужно писать в главной процедуре:
Call ПреобразоватьПолеВТекст("^d REF") ' преобразуем REF
Call ПреобразоватьПолеВТекст("^d SEQ") ' преобразуем SEQ
Call ПреобразоватьПолеВТекст("^d STYLEREF") ' преобразуем STYLEREF
Call ПреобразоватьПолеВТекст("^d LISTNUM") ' преобразуем LISTNUMАлександр Б, проверьте, может быть пригодится.
Когда тестировал свой код, то обнаружил странную вещь.
Если перед строкой myField.Unlink стоит строка myField.Update, то скорость выполнения кода значительно увеличивается по сравнению со случаем, когда строка myField.Update отсутствует.
Т.е. имеем парадокс: добавление лишней операции - обновление поля непосредственно перед разрывом связи - увеличивает скорость выполнения метода Unlink (причем очень сильно).
Вот, наверно, самый лучший и короткий код для того, чтобы превратить все перекрестные ссылки (поля 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Проверю, если не поленюсь )
По-моему .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Перезагрузил компьютер, вновь открыл тестовый пример и... действительно, разницы в скорости выполнения не заметил 
.
Видимо был какой то глюк у компьютера во время отладки макроса.
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться