Originally Posted by
Chas Kenyon
This is harder than you might think. See
Word Doesn't Know What a Page Is
It will depend on how the pagination is created.
Why do you want a macro to do this? What is the purpose?
The reason why I want to automate this process is because I have a quite few word documents that I need to change to a new setting, doing it manually would take quite some time so I am looking for a solution that will automate the process. I have succeeded to come a bit on the way, see code below. However I have a few problems that I still can't fix:
- I get a pop up window to choose what pages I want to remove, if possible, I would like to skip this process and automate so it removes page 1-2 by itself.
- As I enter the data in the pop up window for which pages to remove, the code bugs and I need to debug it and run the code again 2x times, then it works. I find it quite weird but could be a logical reason for this. It bugs at "objRange.Delete".
- All the content for the first and last page is removed, but the pages remain in word as blanks, would like to remove them completely.
Once again, all help is much appreciated!
'' Removes the last page
Dim rng As Range
With ActiveDocument
Set rng = .GoTo(What:=wdGoToPage, Name:=.ComputeStatistics(wdStatisticPages))
Set rng = rng.GoTo(What:=wdGoToBookmark, Name:="\page")
rng.Delete
End With
'' removes first two pages
Dim objRange As Range
Dim strPage As String
Dim objDoc As Document
Dim nSplitItem As Long
Application.ScreenUpdating = False
' Initialize and enter page numbers of pages to be deleted.
Set objDoc = ActiveDocument
strPage = InputBox("Enter the page numbers of pages to be deleted: " & vbNewLine & _
"use comma to separate numbers", "Delete Pages", "For example: 1,3")
nSplitItem = UBound(Split(strPage, ","))
' Find specified pages and highlight their contents.
For nSplitItem = nSplitItem To 0 Step -1
With ActiveDocument
Selection.GoTo What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=Split(strPage, ",")(nSplitItem)
Set objRange = .Bookmarks("\Page").Range
objRange.Delete
End With
Next nSplitItem
Application.ScreenUpdating = True