Sub kk1206190933()

  Dim wNum As Integer

  Dim wPag As Integer

  With Selection

  wPag = .Information(wdNumberOfPagesInDocument)

    For wNum = Int(wPag / 3) * 3 To 3 Step -3

      .GoTo wdGoToPage, , wNum

      .Bookmarks("\Page").Range.Delete

    Next

  End With

End Sub

Sub GetBlankPage()

Dim IsDelete As Boolean

Dim PageCount As Long

Dim rRange     As Range

Dim iInt     As Integer, DelCount As Integer

Dim tmpstr As String

    IsDelete = True

    PageCount = ThisDocument.BuiltInDocumentProperties(wdPropertyPages)

    For iInt = 1 To PageCount

        '超过PageCount退出

        If iInt > PageCount Then Exit For

        '取每一页的内容

        If iInt = PageCount Then

            Set rRange = ThisDocument.Range( _

                            Start:=ThisDocument.GoTo(wdGoToPage, wdGoToAbsolute, iInt).Start)

        Else

            Set rRange = ThisDocument.Range( _

                            Start:=ThisDocument.GoTo(wdGoToPage, wdGoToAbsolute, iInt).Start, _

                            End:=ThisDocument.GoTo(wdGoToPage, wdGoToAbsolute, iInt + 1).Start _

                            )

        End If

        If Replace(rRange.Text, Chr(13), "") = "" Or Replace(rRange.Text, Chr(13), "") = Chr(12) Then

            tmpstr = tmpstr & "第 " & iInt & " 页是空页" & vbCrLf

            '删除?

            If IsDelete Then

                DelCount = DelCount + 1

                '删除空白页

                rRange.Text = Replace(rRange.Text, Chr(13), "")

                rRange.Text = ""

                '重算页数

                PageCount = ThisDocument.BuiltInDocumentProperties(wdPropertyPages)

                If iInt <> PageCount Then

                    '页删除后，页码变化，重新检查当前页

                    iInt = iInt - 1

                Else

                    '最后一个空页

                    Set rRange = ThisDocument.Range( _

                                    Start:=ThisDocument.GoTo(wdGoToPage, wdGoToAbsolute, PageCount - 1).Start, _

                                    End:=ThisDocument.GoTo(wdGoToPage, wdGoToAbsolute, PageCount + 1).Start _

                                    )

                    '如果是分页符,删除上一页中的换页符

                    If InStr(1, rRange.Text, Chr(12)) > 0 Then

                        rRange.Characters(InStr(1, rRange.Text, Chr(12))) = ""

                    Else

                        '没有分页符,通过选中后删除,最好不这样做，如果判断错误，有误删除的风险

                        Set rRange = ThisDocument.Range( _

                                        Start:=ThisDocument.GoTo(wdGoToPage, wdGoToAbsolute, iInt).Start)

                        rRange.Select

                        Selection.Delete

                    End If

                    Exit For

                End If

            End If

        End If

    Next

    If 1 = 1 Or Not IsDelete Then

        If tmpstr = "" Then

            MsgBox "没有空页", vbInformation + vbOKOnly

        Else

            MsgBox tmpstr, vbInformation + vbOKOnly

        End If

    Else

        If DelCount > 0 Then MsgBox "删除空页 " & DelCount, vbInformation + vbOKOnly

    End If

End Sub

Sub AA()

Dim myRange As Range

Dim wNum As Integer

Dim wPag As Integer

Dim start As Integer

wPag = Selection.Information(wdNumberOfPagesInDocument)

Selection.GoTo wdGoToPage, wdGoToAbsolute, 3

MsgBox (Selection.Range.start & "+" & Selection.Range.End)

start = Selection.Range.start

       '.EndKey Unit:=wdStory

       'myRange.End = .Range.Start

       'MsgBox (myRange.Text)

      'If Replace(.Range.Text, Chr(13), "") = "" Or Replace(.Range.Text, Chr(13), "") = Chr(12) Then

       '.Bookmarks("\Page").Range.Delete

      'End If

  Selection.EndKey Unit:=wdStory

  Selection.Select

  MsgBox (Selection.Range.start & "+" & Selection.Range.End)

  'Set myRange = ActiveDocument.Range(ActiveDocument.GoTo(wdGoToPage, wdGoToAbsolute, 3).start, End:=ActiveDocument.GoTo(wdGoToPage, wdGoToAbsolute, 3).start)

 Set myRange = ActiveDocument.Range(start, End:=Selection.start)

  MsgBox (myRange.Text)

End Sub