根据段落编号自动添加书签的VBA

Sub 宏1() ' ' 宏1 宏 ' '    Dim myRange As Word.Range

Dim num As String, content As String

Selection.HomeKey Unit:=wdLine

Selection.EndKey Unit:=wdLine, Extend:=wdExtend

Set myRange = Selection.Range

With myRange  '把Range结束范围往前移一个字符，目的是为了不包括换行符

.MoveEnd Unit:=wdWord, Count:=-1

'取出段落序号

num = Trim(.ListFormat.ListString)

'取出Heading的内容

content = Trim(.Text) End With

If num <> "" Then

num = Replace(num, ".", "_")

With ActiveDocument.Bookmarks

.Add Range:=Selection.Range, Name:="P" + num

.DefaultSorting = wdSortByName

.ShowHidden = False

End With

End If End Sub

------------------------------------插入域和页码域

Sub 宏1() ' ' 宏1 宏 ' ' Dim myRange As Word.Range

Dim num As String

Selection.HomeKey Unit:=wdLine

Selection.EndKey Unit:=wdLine, Extend:=wdExtend

Set myRange = Selection.Range

With myRange  '把Range结束范围往前移一个字符，目的是为了不包括换行符

.MoveEnd Unit:=wdWord, Count:=-1

num = Trim(.Text) End With

If num <> "" Then

num = Replace(num, ".", "_")

Selection.Text = "" Selection.End = Selection.Start

'插入域

Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty,_PreserveFormatting:=False

Selection.TypeText Text:="ref p" + num + " \n \h"

’ 光标挪到行尾

Selection.EndKey Unit:=wdLine

Selection.Start = Selection.End

Selection.TypeText Text:=", P"

Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _PreserveFormatting:=False

Selection.TypeText Text:="pageref p" + num

Selection.Fields.ToggleShowCodes

Selection.MoveDown Unit:=wdLine, Count:=1

Selection.Fields.ToggleShowCodes

End If

End Sub