<em>word</em>中如何获取当前所显示的<em>页码</em>

如下：

Sub test()
    p = ExecuteExcel4Macro("Get.Document(50)")
    MsgBox "目前是第" & ThisPage & "页" & Chr(10) & _
           "共" & p & "页"
End Sub
Function ThisPage() As Integer
    Dim sAddr As String, PA As Range
    Dim R0 As Long, C0 As Long
    Dim PAHeight As Long, PAWidth As Long
    Dim Down As Long, Across As Long
    Dim Outside As Long
    Dim NumPage As Long
    If ExecuteExcel4Macro("Get.Document(50)") = 0 Then
        NumPage = ""
        Exit Function
    End If
    If ExecuteExcel4Macro("Get.Document(50)") = 1 Then
        NumPage = 1
        Exit Function
    End If
    sAddr = ExecuteExcel4Macro("GET.DOCUMENT(81)")    '印表区域
    If sAddr <> "" Then    '如果有设定列表区域
        Set PA = Range(sAddr)
    Else
        With ActiveSheet.UsedRange
            Set PA = Range(Cells(1, 1), .Cells(.Cells.Count))    '设定列表区域
        End With
    End If
    If Intersect(ActiveCell, PA) Is Nothing Then
        MsgBox "目前储存格e5a48de588b67a686964616f361不在列印范围中!"
        NumPage = ""
        Exit Function
    End If
    R0 = PA.Row
    aaa = PA.Address
    PAHeight = GetRowBreaks(R0 + PA.Rows.Count - 1) + 1
    Down = GetRowBreaks(ActiveCell.Row) + 1
    If R0 > 1 Then
        Outside = GetRowBreaks(R0)
        PAHeight = PAHeight - Outside
        Down = Down - Outside
    End If
    C0 = PA.Column
    PAWidth = GetColBreaks(C0 + PA.Columns.Count - 1) + 1
    Across = GetColBreaks(ActiveCell.Column) + 1
    If C0 > 1 Then
        Outside = GetColBreaks(C0)
        PAWidth = PAWidth - Outside
        Across = Across - Outside
    End If
    If ExecuteExcel4Macro("GET.DOCUMENT(61)") = 1 Then    '1 = 先列后行,2 = 先行后列
        '1 = down then over, 2 = over then down
        NumPage = PAHeight * (Across - 1) + Down
    Else
        NumPage = PAWidth * (Down - 1) + Across
    End If
    ThisPage = NumPage
End Function
Private Function GetColBreaks(ColNum As Long) As Long
    Dim sTemp As String
    aa = ExecuteExcel4Macro("GET.DOCUMENT(65)")
    sTemp = Replace("MATCH(#,GET.DOCUMENT(65),1)", "#", ColNum)
    On Error Resume Next
    '取得指定栏位所在的垂直分页线
    GetColBreaks = ExecuteExcel4Macro(sTemp)
End Function
Private Function GetRowBreaks(RowNum As Long) As Long
    Dim sTemp As String
    sTemp = Replace("MATCH(#,GET.DOCUMENT(64),1)", "#", RowNum)
    On Error Resume Next
    '取得指定列位所在的水平分页线
    GetRowBreaks = ExecuteExcel4Macro(sTemp)
End Function

点击右边的滚动条后在滚动条旁边就能显示当前显示页的页码了（好像只有这个方法）。看图，（GIF须点击打开后观看）

只能用VBA解决，下面的代码由 cbtaja 录制，将下面代码粘贴进 工具--宏--VB编辑器后，用公式 =ThisPageNo 显示当前页数，=PagesCount显示总页数；=TEXT(ThisPageNo,"第0页 ")&TEXT(PagesCount,"共0页") 在同一单元格显示当前页数和总页数

Sub 定义页码及总页数名称()
'
' 定义页码及总页数名称 Macro

'

'
ActiveWorkbook.Names.Add Name:="ColFirst", RefersToR1C1:= _
"=GET.DOCUMENT(61)" '判断打印顺序的设置类型e799bee5baa6e997aee7ad94e58685e5aeb9361
ActiveWorkbook.Names.Add Name:="lstRow", RefersToR1C1:= _
"=GET.DOCUMENT(10)" '本工作表已用到的最大行数
ActiveWorkbook.Names.Add Name:="lstColumn", RefersToR1C1:= _
"=GET.DOCUMENT(12)" '本工作表已用到的最大列数
ActiveWorkbook.Names.Add Name:="hNum", RefersToR1C1:= _
"=IF(ISERROR(FREQUENCY(GET.DOCUMENT(64),Row())),0,FREQUENCY(GET.DOCUMENT(64),Row()))" 'hNum为本单元格上方的水平分页符个数
ActiveWorkbook.Names.Add Name:="vNum", RefersToR1C1:= _
"=IF(ISERROR(FREQUENCY(GET.DOCUMENT(65),Column())),0,FREQUENCY(GET.DOCUMENT(65),Column()))" ''本单元格左边的垂直分页个数
ActiveWorkbook.Names.Add Name:="hSum", RefersToR1C1:= _
"=IF(ISERROR(FREQUENCY(GET.DOCUMENT(64),lstRow)),0,FREQUENCY(GET.DOCUMENT(64),lstRow))" ''本工作表最后一个单元格上方的水平分页符个数
ActiveWorkbook.Names.Add Name:="vSum", RefersToR1C1:= _
"=IF(ISERROR(FREQUENCY(GET.DOCUMENT(65),lstColumn)),0,FREQUENCY(GET.DOCUMENT(65),lstColumn))" ''本工作表最后一个单元格左边的垂直分页个数
ActiveWorkbook.Names.Add Name:="ThisPageNo", RefersToR1C1:= _
"=IF(ColFirst,(hSum+1)*vNum+hNum+1,(vSum+1)*hNum+vNum+1)*ISNUMBER(NOW())" '单元格所在页码
ActiveWorkbook.Names.Add Name:="PagesCount", RefersToR1C1:= _
"=GET.DOCUMENT(50)*ISNUMBER(NOW())" '本工作表的总页数
End Sub

Sub Macro2()
   Dim r, p, r0, p0, rr, pp
    p= Selection.Information(wdActiveEndPageNumber) '当前页码e68a84e799bee5baa6e997aee7ad94334
    r= Selection.Information(wdFirstCharacterLineNumber) '当前行
    
    '数行数
   p0 = p
   rr = r
   Do
       Selection.MoveDown Unit:=wdLine, Count:=1
       pp = Selection.Information(wdActiveEndPageNumber)
       r0 = Selection.Information(wdFirstCharacterLineNumber)
       If pp > p Then
           '退回原处
           Selection.MoveUp Unit:=wdLine, Count:=(rr - r + 1)
           Exit Do
       End If
       If rr = r0 Then
           '退回原处
          Selection.MoveUp Unit:=wdLine, Count:=(rr - r)
           Exit Do
       End If
       rr = r0
    Loop
   MsgBox "当前页码：" & p & vbCrLf & "本页总行数：" & rr
End Sub

 申请加悬赏分！！！