请教，如何在目录的页码中自动显示章节号？

守柔

删除这行代码即可。

如果你觉得搞不明白，为什么不直接上传一份代表性的文档。

billdon

是啊，是我太笨了，连这都没想到！请再帮我看看这个文件！谢谢了！

2VCVJ4XA.rar (26.7 KB, 下载次数: 8)

2006-11-20 13:57 上传

点击文件名下载附件

[此贴子已经被作者于2006-11-20 13:57:05编辑过]

守柔

以下代码供参考：

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By SHOUROU@ExcelHome 2006-11-20 18:40:31
'仅测试于System: Windows NT Word: 11.0 Language: 2052
'№ 0102^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Option Explicit
Sub Example()
'运行本代码前请新更新目录域
    Dim myTableContent As TableOfContents, oField As Field
    Dim strField As String, myStyle As String, myRange As Range
    Dim N As Integer, ColId As Byte, myPage As String
    On Error GoTo ErrHandle
    With ActiveDocument
        If .TablesOfContents.Count < 1 Then Exit Sub
        Application.ScreenUpdating = False    '关闭屏幕更新
        myStyle = "标题 1"    '此处设置需要加入作者的段落样式,通常应为第一标题级别
        Set myTableContent = .TablesOfContents(1)    '定义为活动文档的第一个目录
        For Each oField In myTableContent.Range.Fields    '在目录所有区域中域中循环
            strField = VBA.UCase(oField.Code.Text)    '取得域代码的大写(统一,以便后续处理)
            If VBA.InStr(strField, " HYPERLINK \L") > 0 Then    '如果含有指定字符
                strField = VBA.Replace(strField, " HYPERLINK \L ", "")    '删除该指定文本
                strField = VBA.Replace(strField, " ", "")    '删除空格
                strField = VBA.Replace(strField, """", "")    '删除半角引号
                Set myRange = .Bookmarks(strField).Range
                myRange.SetRange myRange.Start, myRange.Start
             

守柔

   N = myRange.Information(wdActiveEndPageNumber)
                If N Mod 2 = 0 Then ColId = 1 Else ColId = 3
                myPage = .ActiveWindow.ActivePane.Pages(N).Rectangles(1).Range.Tables(1).Cell(1, ColId).Range.Text
                myPage = VBA.Mid(myPage, 1, Len(myPage) - 2)    '取得章节号
                myPage = VBA.Replace(myPage, " ", "")
                myPage = VBA.Replace(myPage, "SP.", "")
                myPage = CStr(Val(myPage))
                Set myRange = oField.Result.Paragraphs(1).Range    '取得一个Range对象
                With myRange
                    .SetRange .End - 1, .End - 1    '段落标记结束前一个字符位置
                    .InsertAfter myPage    '章节号
                    .Font.Color = wdColorBlack    '黑色
                    .Font.Underline = False    '取消下划线(默认为继续的超链接格式,此次设置为常规文本格式)
                End With
                oField.Next.Delete    '删除原来的页码引用域
            End If
        Next
    End With
    Application.ScreenUpdating = True    '恢复屏幕更新
    Exit Sub
ErrHandle:
    MsgBox "错误:" & Err.Number & vbLf & "可能的原因:" & Err.Description, vbExclamation
End Sub
'----------------------

billdon

谢谢老大！

billdon

还有一个小问题，例如本来正文的页码为"3.31.1"，而在目录中仅出现“3.3”，不知为何？请老大再帮看看！另外，能不能将目录中“..........................”后面的章节和页码（例如"3.31.1"）都变成小5号ARIAL字体 。谢谢！！！

[此贴子已经被作者于2006-11-21 10:31:43编辑过]

守柔

QUOTE:

以下是引用billdon在2006-11-21 10:28:35的发言：

还有一个小问题，例如本来正文的页码为"3.31.1"，而在目录中仅出现“3.3”，不知为何？请老大再帮看看！另外，能不能将目录中“..........................”后面的章节和页码（例如"3.31.1"）都变成小5号ARIAL字体 。谢谢！！！

我一直呼吁您上传具有代表性的文档。

把代码中的这句删除试一下：

    myPage = CStr(Val(myPage))

在这段代码中修改添加：

   With myRange
                    .SetRange .End - 1, .End - 1    '段落标记结束前一个字符位置
                    .InsertAfter myPage    '章节号
                    .Font.Color = wdColorBlack    '黑色
.Font.Name = "Arial"
.Font.Size = 10
                    .Font.Underline = False    '取消下划线(默认为继续的超链接格式,此次设置为常规文本格式)
                End With

billdon

十分感谢！