|
说明：
WORD中的多节节数指定，一直是多年来的心病，这次终于下定决心研究了一下，但愿能解决问题。
一：我未对此作更多的测试，请有需求者测试后即时反馈于我。
二：这是一个VBA与域相结合的程序，你可以将这段代码直接复制于你的文档中，然后运行
1.建议在全档全部结束后,当然,你可以随时运行,最终的页眉中的调整应该放在全部成稿后,你可以复制部分域代码在页脚中或者你认为需要的地方.如果是页脚中,请关闭同前按钮
2.如果你需要设置页眉样式,请在最终成稿后设置,或者,节数不会增加的情况下进行设置
3.本节中的内容增删,无需运行宏,它会自动生成;运行宏只是在你的文档需要增加节时起作用,它会删除原来所有的页眉中的内容.
4.本程序的原理是按照域中的运算\书签域和书签域所在页数进行的,如果你想不用VBA,可以参考里面的域代码公式进行手动设置书签.
核心域代码为: 总第{ PAGE }页共{ NUMPAGES }页第{ SECTION }节 ,本节第{ ={ PAGE }-{ PAGEREF myBK_S1 }+1 }页, 本节共{ SECTIONPAGES }页 其中myBK-S*是个变量
'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By I Love You_Word!@ExcelHome 2005-11-11 17:20:36
'仅测试于System: Windows NT Word: 10.0 Language: 2052
'№ 00050^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Option Explicit
Sub AllPages()
Dim i As Section, myRange As Range, myBk As Bookmark, strBk As String
Dim KeyRange As Range, BtLenth As Byte
On Error Resume Next
With ActiveDocument
If .Sections.Count = 1 Then Exit Sub
Application.ScreenUpdating = False
For Each myBk In .Bookmarks
If VBA.InStr(myBk.Name, "myBK_S") = 1 Then myBk.Delete
Next
For Each i In .Sections
Set myRange = .Range(i.Range.Start, i.Range.Start)
strBk = "myBK_S" & i.Index
BtLenth = Len(strBk)
.Bookmarks.Add strBk, myRange
With i.Headers(wdHeaderFooterPrimary)
Set KeyRange = .Range
.LinkToPrevious = False
.Range.Text = "总第PAGE页共NUMPAGES页" & Chr(13) & "第SECTION节 ,本节第=PAGE-PAGEREF " & strBk & "+1页, 本节共SECTIONPAGES页"
Set KeyRange = .Range
KeyRange.SetRange KeyRange.Start + 38, KeyRange.Start + 38 + 8 + BtLenth
KeyRange.Fields.Add KeyRange, wdFieldEmpty, , False
Set KeyRange = .Range
KeyRange.SetRange KeyRange.Start + 33, KeyRange.Start + 37
KeyRange.Fields.Add KeyRange, wdFieldEmpty, , False
Set KeyRange = .Range
KeyRange.SetRange KeyRange.Start + 32, KeyRange.End - 20
KeyRange.Fields.Add KeyRange, wdFieldEmpty, , False
Set KeyRange = .Range
KeyRange.SetRange KeyRange.End - 14, KeyRange.End - 2
KeyRange.Fields.Add KeyRange, wdFieldEmpty, , False
Set KeyRange = .Range
KeyRange.SetRange KeyRange.Start + 19, KeyRange.Start + 26
KeyRange.Fields.Add KeyRange, wdFieldEmpty, , False
Set KeyRange = .Range
KeyRange.SetRange KeyRange.Start + 8, KeyRange.Start + 16
KeyRange.Fields.Add KeyRange, wdFieldEmpty, , False
Set KeyRange = .Range
KeyRange.SetRange KeyRange.Start + 2, KeyRange.Start + 6
KeyRange.Fields.Add KeyRange, wdFieldEmpty, , False
.Range.Fields.Update
End With
Next
End With
Application.ScreenUpdating = True
End Sub
'----------------------
qjTQnZsS.zip
(20.59 KB, 下载次数: 200)
[此贴子已经被作者于2005-11-11 17:31:54编辑过] | 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2005-11-11 17:27
发表于 2005-11-11 17:57
楼主
