宏来更新word文档中的所有字段 [英] Macro to update all fields in a word document
问题描述
多年来,我已经构建了一个 vba 宏,用于更新 Word 文档中的所有字段.
I have built - over the years - a vba macro that is supposed to update all fields in a word document.
我在发布文档以供审核之前调用此宏,以确保所有页眉和页脚等均正确无误.
I invoke this macro before releasing the document for review to ensure all headers and footers etc are correct.
目前 - 它看起来像这样:
Currently - it look like this:
Sub UpdateAllFields()
'
' UpdateAllFields Macro
'
'
Dim doc As Document ' Pointer to Active Document
Dim wnd As Window ' Pointer to Document's Window
Dim lngMain As Long ' Main Pane Type Holder
Dim lngSplit As Long ' Split Type Holder
Dim lngActPane As Long ' ActivePane Number
Dim rngStory As Range ' Range Objwct for Looping through Stories
Dim TOC As TableOfContents ' Table of Contents Object
Dim TOA As TableOfAuthorities 'Table of Authorities Object
Dim TOF As TableOfFigures 'Table of Figures Object
Dim shp As Shape
' Set Objects
Set doc = ActiveDocument
Set wnd = doc.ActiveWindow
' get Active Pane Number
lngActPane = wnd.ActivePane.Index
' Hold View Type of Main pane
lngMain = wnd.Panes(1).View.Type
' Hold SplitSpecial
lngSplit = wnd.View.SplitSpecial
' Get Rid of any split
wnd.View.SplitSpecial = wdPaneNone
' Set View to Normal
wnd.View.Type = wdNormalView
' Loop through each story in doc to update
For Each rngStory In doc.StoryRanges
If rngStory.StoryType = wdCommentsStory Then
Application.DisplayAlerts = wdAlertsNone
' Update fields
rngStory.Fields.Update
Application.DisplayAlerts = wdAlertsAll
Else
' Update fields
rngStory.Fields.Update
If rngStory.StoryType <> wdMainTextStory Then
While Not (rngStory.NextStoryRange Is Nothing)
Set rngStory = rngStory.NextStoryRange
rngStory.Fields.Update
Wend
End If
End If
Next
For Each shp In doc.Shapes
If shp.Type <> msoPicture Then
With shp.TextFrame
If .HasText Then
shp.TextFrame.TextRange.Fields.Update
End If
End With
End If
Next
' Loop through TOC and update
For Each TOC In doc.TablesOfContents
TOC.Update
Next
' Loop through TOA and update
For Each TOA In doc.TablesOfAuthorities
TOA.Update
Next
' Loop through TOF and update
For Each TOF In doc.TablesOfFigures
TOF.Update
Next
' Header and footer too.
UpdateHeader
UpdateFooter
' Return Split to original state
wnd.View.SplitSpecial = lngSplit
' Return main pane to original state
wnd.Panes(1).View.Type = lngMain
' Active proper pane
wnd.Panes(lngActPane).Activate
' Close and release all pointers
Set wnd = Nothing
Set doc = Nothing
End Sub
Sub UpdateFooter()
Dim i As Integer
'exit if no document is open
If Documents.Count = 0 Then Exit Sub
Application.ScreenUpdating = False
'Get page count
i = ActiveDocument.BuiltInDocumentProperties(14)
If i >= 1 Then 'Update fields in Footer
For Each footer In ActiveDocument.Sections(ActiveDocument.Sections.Count).Footers()
footer.Range.Fields.Update
Next
End If
Application.ScreenUpdating = True
End Sub
'Update only the fields in your footer like:
Sub UpdateHeader()
Dim i As Integer
'exit if no document is open
If Documents.Count = 0 Then Exit Sub
Application.ScreenUpdating = False
'Get page count
i = ActiveDocument.BuiltInDocumentProperties(14)
If i >= 1 Then 'Update fields in Header
For Each header In ActiveDocument.Sections(ActiveDocument.Sections.Count).Headers()
header.Range.Fields.Update
Next
End If
Application.ScreenUpdating = True
End Sub
我最近注意到它有时会遗漏文档的某些部分.今天错过了首页页脚-section 2-,因为文档版本没有更新.
I have noticed recently that it sometimes misses some secions of the document. Today it missed First page footer -section 2- because the document version was not updated.
我已经建立了这个宏多年并进行了几次研究,但我并不以此为荣,所以如果现在有一种干净的方法,请建议一个完整的替代品.我使用的是 Word 2007.
I have built this macro over a number of years and several bouts of research but I am not proud of it so please suggest a complete replacement if there is now a clean way of doing it. I am using Word 2007.
要进行测试,请创建一个 Word 文档并添加一个名为 Version
的自定义字段并为其赋值.然后在尽可能多的地方使用该字段 {DOCPROPERTY Version * MERGEFORMAT }
.页眉、页脚、首页、后续页等.请记住使用不同的页眉/页脚制作多节文档.然后更改属性并调用宏.它目前做得很好,处理 TOC 和 TOA 和 TOF 等,例如,它似乎只是跳过多节文档中的页脚(有时).
To test, create a word document and add a custom field named Version
and give it a value. Then use that field {DOCPROPERTY Version * MERGEFORMAT }
in as many places as you can. Headers, Footers, first-page, subsequent page etc. etc. Remember to make a multi-section document with different header/footers. Then change the property and invoke the macro. It currently does quite a good job, handling TOCs and TOAs an TOFs etc, it just seems to skip footers (sometimes) in a multi-section document for example.
似乎引起最多问题的具有挑战性的文档结构如下:
The challenging document that seems to cause the most problems is structured like this:
它有 3 个部分.
第 1 部分用于标题页和目录,因此该部分的第一页没有页眉/页脚,但确实使用了 Version
属性.后续页面的页码以罗马数字表示,用于 TOC.
Section 1 is for the title page and TOC so the first page of that section has no header/footer but does use the Version
property on it. Subsequent pages have page numbering in roman numerals for the TOC.
第 2 部分是文档正文,有页眉和页脚.
Section 2 is for the body of the document and has headers and footers.
第 3 部分是版权简介,它有一个非常奇怪的页眉和一个精简的页脚.
Section 3 is for the copyright blurb and this has a very strange header and a cut-down footer.
所有页脚都包含 Version
自定义文档属性.
All footers contain the Version
custom document property.
我上面的代码似乎适用于所有情况,但有时会遗漏第 2 节和第 3 节的首页页脚.
My code above seems to work in all cases except sometimes it misses first page footer of sections 2 and 3.
推荐答案
多年来,我用来更新文档中所有字段(TOC 等除外,它们是单独处理的)的标准是Word MVP 使用和推荐的,我将复制到这里.它来自 Greg Maxey 的网站:http://gregmaxey.mvps.org/word_tip_pages/word_fields.html.我在您的版本中没有看到的一件事是更新页眉/页脚中形状(文本框)中的任何字段.
For years, the standard I've used for updating all fields (with the exception of TOC, etc. which are handled separately) in a document is the one the Word MVPs use and recommend, which I'll copy here. It comes from Greg Maxey's site: http://gregmaxey.mvps.org/word_tip_pages/word_fields.html. One thing it does that I don't see in your version is update any fields in Shapes (text boxes) in the header/footer.
Public Sub UpdateAllFields()
Dim rngStory As Word.Range
Dim lngJunk As Long
Dim oShp As Shape
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
For Each rngStory In ActiveDocument.StoryRanges
'Iterate through all linked stories
Do
On Error Resume Next
rngStory.Fields.Update
Select Case rngStory.StoryType
Case 6, 7, 8, 9, 10, 11
If rngStory.ShapeRange.Count > 0 Then
For Each oShp In rngStory.ShapeRange
If oShp.TextFrame.HasText Then
oShp.TextFrame.TextRange.Fields.Update
End If
Next
End If
Case Else
'Do Nothing
End Select
On Error GoTo 0
'Get next linked story (if any)
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Next
End Sub
这篇关于宏来更新word文档中的所有字段的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!