怎么用VBA只保留word的最后一页

单曲循环丶づ

word的页数不固定，怎么用VBA把前面页的内容都删除，只保留最后一页？

希望高手帮帮忙

loquat

1. Sub 保留最后一页()
   
2. Dim Pages As Long
   
3. With ActiveDocument
   
4.     Pages = .ComputeStatistics(wdStatisticPages)
   
5.     .SaveAs filename:=.Path & "\最后一页-" & .Name '改名存盘
   
6.     If Pages <> 1 Then .Range(0, .Range(0, 0).GoTo(wdGoToPage, wdGoToAbsolute, Pages).Start).Delete  '如果大于1页，则只保留尾页
   
7.     .Close True  '当前文档已变为另存后的文档，保存修改
   
8. End With
   
9. End Sub

复制代码

413191246se

* 保留副本后，在副本上操作，保留最后一页内容，请楼主试试下面的宏：
Sub test()
'保留最后一页
    ActiveDocument.SaveAs FileName:=ActiveDocument.Path & "\" & Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 4) & "_副本" & ".doc"

    Selection.EndKey Unit:=wdStory
'Sub 选定当前页()
'code by 守柔
    Dim CurrentPageStart As Long, CurrentPageEnd As Long
    Dim CurrentPage As Integer, Pages As Integer
    On Error Resume Next
    With Selection
        CurrentPage = .Information(wdActiveEndPageNumber)
        Pages = .Information(wdNumberOfPagesInDocument)
        CurrentPageStart = .GoTo(What:=wdGoToPage, Which:=wdGoToNext, Name:=CurrentPage).Start
        If CurrentPage = Pages Then
            CurrentPageEnd = ActiveDocument.Content.End
        Else
            CurrentPageEnd = .GoTo(What:=wdGoToPage, Which:=wdGoToNext, Name:=CurrentPage + 1).Start
        End If
        ActiveDocument.Range(CurrentPageStart, CurrentPageEnd).Select
    End With
   
    Selection.Copy
    ActiveDocument.Content.Delete
    Selection.Paste
    ActiveDocument.Close savechanges:=wdSaveChanges
   
End Sub

山菊花

简化楼上的宏：

1. Sub 保留最后一页()
   
2.     Dim CurrentPageStart As Long, CurrentPageEnd As Long
   
3.     Dim Pages As Integer
   
4.     With Selection
   
5.         Pages = .Information(wdNumberOfPagesInDocument) '总页数
   
6.         If Pages = 1 Then Exit Sub
   
7.         ActiveDocument.SaveAs FileName:=ActiveDocument.Path & "\(最后一页)" & ActiveDocument.Name '改名存盘
   
8.         CurrentPageStart = .GoTo(What:=wdGoToPage, Which:=wdGoToNext, Name:=Pages).Start '取得最后一页开始位置
   
9.         CurrentPageEnd = ActiveDocument.Content.End '文档结束位置
   
10.         ActiveDocument.Content.Text = ActiveDocument.Range(CurrentPageStart, CurrentPageEnd).Text '用最后一页内容覆盖文档
    
11.     End With
    
12.     ActiveDocument.Close savechanges:=wdSaveChanges
    
13. End Sub

复制代码

413191246se

总版主大人 与高人 loquat 竞相献艺，功力深厚，佩服！佩服！（越简单越好，就喜欢简洁的代码。）

单曲循环丶づ

问题解决了，谢谢各位啦~~（不知道怎么设置最佳答案）

kqbt

用预定义书签试试：

1. Sub 仅保留末页()
   
2.   Selection.EndKey wdStory
   
3.   Documents.Add.Content = ActiveDocument.Bookmarks("\Page").Range
   
4. End Sub

复制代码