Ala*_*ain 3 excel vba ms-word word-field
我正在根据模板分段构建一个大型文档。#OVERALLPAGENUMBER#
每个模板的页脚中都有一个关键字,我以编程方式将其替换为字段(使用 Excel VBA)。
如果我需要的只是该文档的页码,那么以下内容就足够了:
Dim storyRange As Object 'Word.Range
For Each storyRange In oDoc.StoryRanges
Do
With storyRange.Find
.Text = "#OVERALLPAGENUMBER#"
.Wrap = 1 'wdFindContinue
.Execute
While .found
storyRange.Fields.Add Range:=storyRange, Type:=-1, Text:="PAGE", PreserveFormatting:=True
.Execute
Wend
End With
On Error Resume Next
Set storyRange = storyRange.NextStoryRange
On Error GoTo 0
Loop While Not storyRange Is Nothing
Next
Run Code Online (Sandbox Code Playgroud)
我已经测试了这段代码,它成功地将页码放入页脚中。然而,我想要的是一个嵌套(公式)字段,它将固定数字添加到页码,以便我可以显示多个文档的页数。我的解决方案,如果我手动执行(使用 Ctrl+F9),给出的字段代码如下所示:
{ = 5 + { PAGE } }
Run Code Online (Sandbox Code Playgroud)
并正确生成第 1 页上的“6”、第 2 页上的“7”等......
不管我怎么尝试,我都无法使用 VBA 复制这种字段嵌套。(宏记录器在这里没用)。有人能找到以编程方式创建这些字段的方法吗?
解决方案
我的问题是,拥有PreserveFormatting:=True
阻碍了我将一个字段嵌套在另一个字段中的尝试。现在,以下简单的解决方案有效:
With storyRange.Find
.Text = "#POLICYPAGENO#"
.Wrap = 1 'wdFindContinue
.Execute
While .found
storyRange.Select
With oDoc.ActiveWindow
.Selection.Fields.Add Range:=.Selection.Range, Type:=-1, Text:="PAGE", PreserveFormatting:=False
.Selection.MoveLeft Unit:=1, Count:=1, Extend:=1
.Selection.Fields.Add Range:=.Selection.Range, Type:=-1, PreserveFormatting:=False
.Selection.TypeText Text:="= " & OverallPageNumber & " +"
End With
.Execute
Wend
End With
Run Code Online (Sandbox Code Playgroud)
小智 5
我知道这已经很旧了,但是昨天尝试这样做时,我发现了一个比使用 Selection 对象更简单的创建嵌套字段的解决方案。我在网上找到的唯一解决方案错误地表示,如果不使用 Selection 对象,就无法插入嵌套字段。但是,我发现您可以将嵌套字段插入 Field.Code 范围,这使得代码更易于操作、更快、更直观。如:
Dim storyRange As Object 'Word.Range
For Each storyRange In oDoc.StoryRanges
Do
With storyRange.Find
.Text = "#OVERALLPAGENUMBER#"
.Wrap = 1 'wdFindContinue
.Execute
While .Found
Set fld1 = storyRange.Fields.Add(Range:=storyRange, Type:=-1, Text:="=p+" & OverallPageNumber, PreserveFormatting:=False)
Set fld2 = storyRange.Fields.Add(Range:=fld1.Code.Characters(3), Type:=-1, Text:="PAGE", PreserveFormatting:=False)
fld1.Update
.Execute
Wend
End With
On Error Resume Next
Set storyRange = storyRange.NextStoryRange
On Error GoTo 0
Loop While Not storyRange Is Nothing
Next
Run Code Online (Sandbox Code Playgroud)