根据段落编号自动添加书签的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 + " 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