Solved: Searching and deleteing empty pages but NOT hidden text.

[Hvorfor]

Hello guys,

This week i started to make a template that is going to be used to make various documentation. This template will be used by several diffrent people. So because people have diffrerent habits when it comes to typing in word (some use to much enter/page breaks and dont care about stuff like blank pages etc) I thought I would make a macro that go's trough the document and removes empty pages (ie. Pages with only Return, space tab, page break and other "empty" formating on it).

So far using the all mighty google, and my very limited programming skills have been enugh to make it work OK. However, I have run inn to one problem. The macro considers hidden text (in this case RD fields) as empty formating.

So why is this a problem?

Well, I have decided that every chapter shuld be saved in its own document, so the files wont be to long and for easier reuse of chapters. So i use RD fileds in the "main" doc so the TOC can be updated and the correct page numbers set.

My problem is this:

If i have to many RD fields or the TOC ends at the end of the page the RD fields will end up on an "empty" page, and get deleted by my macro. This in turn will make the macro useless.

So here is the code that i have "Written"/modified from examples i found on google. Im sure there is a better way of doing this, and Im very open for suggestions. The code does more than searching for blank pages, it also checks if the doc has even number of pages, if not it inserts a blank page. It also sets pagenumbers (for all docs) and updates the TOC.

Macro:

Sub TOC_Macro_Test()
Dim oField As Field
Dim strCode As String
Dim iLastPage As Long
Dim oDoc As Document
ChDir ActiveDocument.Path
With ActiveDocument.ActiveWindow.View
.ShowAll = False
.ShowHiddenText = False
.ShowFieldCodes = False
.Type = wdPrintView
End With
Remove_Blank_Pages_Macro
checkForEvenPageNumbers
ActiveDocument.Repaginate
Selection.Move Unit:=wdStory, Count:=1
iLastPage = Selection.Information(wdActiveEndAdjustedPageNumber)
For Each oField In ActiveDocument.Fields
If oField.Type = wdFieldRefDoc Then
strCode = Trim$(oField.Code)
strCode = Trim$(Mid$(strCode, InStr(strCode, " ")))
If LCase$(Left$(strCode, 2)) = "\f" Then
strCode = Trim$(Mid$(strCode, 3))
End If
If LCase$(Right$(strCode, 2)) = "\f" Then
strCode = Trim$(Left$(strCode, Len(strCode) - 2))
End If
If Asc(strCode) = 34 Then
strCode = Trim$(Mid$(strCode, 2, Len(strCode) - 2))
End If
ChDir ActiveDocument.Path
Set oDoc = Documents.Open(FileName:=strCode)
oDoc.Activate
With oDoc.ActiveWindow.View
.ShowAll = False
.ShowHiddenText = False
.ShowFieldCodes = False
.Type = wdPrintView
End With

Remove_Blank_Pages_Macro

checkForEvenPageNumbers

oDoc.Sections(1).Headers(wdHeaderFooterPrimary). _
PageNumbers.RestartNumberingAtSection = True
oDoc.Sections(1).Headers(wdHeaderFooterPrimary). _
PageNumbers.StartingNumber = iLastPage + 1
oDoc.Repaginate
Selection.Move Unit:=wdStory, Count:=1
iLastPage = Selection.Information(wdActiveEndAdjustedPageNumber)
oDoc.Close SaveChanges:=wdSaveChanges
End If
Next oField
ChDir ActiveDocument.Path
ActiveDocument.Fields.Update
End Sub



Function that removes blank pages:

Public Function Remove_Blank_Pages_Macro()
Dim NumberOfPages As Long
Dim CurrentPage As Long
CurrentPage = 1
NumberOfPages = Selection.Information(wdNumberOfPagesInDocument)
Selection.GoTo What:=wdGoToSection, Which:=wdGoToFirst
Selection.ExtendMode = True
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Count:=1
For CurrentPage = 1 To NumberOfPages
Selection.ExtendMode = False
If isBlankSelection Then
If CurrentPage = NumberOfPages Then
ActiveDocument.GoTo(wdGoToPage, wdGoToLast).Bookmarks("\Page").Range.Delete
Selection.ExtendMode = True
Selection.GoTo What:=wdGoToLine, Which:=wdGoToPrevious, Count:=1
If isBlankSelection Then
Selection.Delete
End If
Exit For
End If

Selection.Delete
Selection.ExtendMode = True
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Count:=1
Else
Selection.Collapse (wdCollapseEnd)
Selection.ExtendMode = True
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Count:=1
End If
Next CurrentPage
Selection.Collapse (wdCollapseEnd)
Selection.ExtendMode = False
End Function


Function that checks if the selection is blank:
Public Function isBlankSelection()
For Each c In Selection.Characters
If (c <> vbCr And c <> vbTab And c <> vbFormFeed And c <> " ") Then
isBlankSelection = False
Exit Function
End If

Next
isBlankSelection = True
End Function

Function that inserts a blank page at the end if the document has odd number of pages.

Public Function checkForEvenPageNumbers()
If ActiveDocument.BuiltInDocumentProperties("number of pages") Mod 2 <> 0 Then
Selection.EndKey Unit:=wdStory
Selection.InsertBreak Type:=wdPageBreak
End If
End Function

I hope I have provided enough information for you to help me with my problem.

PS: I'm also looking to write a macro / function that finds the RD fields in the TOC and puts them all on the same line so i dont get a line shift between every RD field.

Thank you,

Even

[Hvorfor]

Sorry,

Forgot to tell you that im using Word 2007 in Windows 7

[Frosty]

You've got an essentially incompatible scenario: you want an accurate page count to determine what information from the document to delete ("blank" stuff), but you have critical information you need to retain marked as hidden text (which, unless you're showing hidden text, will be considered "blank" stuff).

I don't believe Word has always worked like this, as I recently discovered a similar flaw in some methodology I'd had in place for a client for 10+ years, but it is how it works now for Word 2003, 2007 and 2010. However, selection.range = "" if you have .ShowHiddenText = False, even if there is stuff in that range when you have .ShowHiddenText = True with the same selection.

Essentially, you will need to use some function like the following to test if a particular range contains hidden text...


Public Function fIsThereReallyAnyHiddenText(rngTest As Range) As Boolean
Dim lOriginalValue As Boolean

With ActiveWindow.View
'store it
lOriginalValue = .ShowHiddenText
'change itt
.ShowHiddenText = True
'test it
If rngTest = "" Then
fIsThereReallyAnyHiddenText = False
Else
fIsThereReallyAnyHiddenText = True
End If
'restore it
.ShowHiddenText = lOriginalValue
End With
End Function

I can't rewrite all of your routines for you, as I don't currently have time to do that, but I wanted to point you in the right direction.

The above function can still use the selection object, but you would need to pass it in, like so...


If fIsThereReallyAnyHiddenText (Selection.Range) Then
'don't delete it?
Else
'delete it
End if

You can make the test more robust (i.e., add in your tests for blank paragraphs, etc) rather than just test if there is anything in the range, but this should point you in the right direction.

[Hvorfor]

Thank you very much for the reply Frosty!

I'll test it out at work tomorrow, and give some feedback.

Cheers,

Even

[Hvorfor]

Your pointers did the trick Frosty!

It turned out that my code for cheking if it was a blank page did pick up the hidden text once it was enabled. So i used some of your code to make sure the hidden text is visible when that function is running.

Here is the result:

Public Function isBlankSelection()
Dim lOriginalValue As Boolean
With ActiveWindow.View
'store it
lOriginalValue = .ShowHiddenText
'change it
.ShowHiddenText = True
For Each c In Selection.Characters
If (c <> vbCr And c <> vbTab And c <> vbFormFeed And c <> " ") Then
isBlankSelection = False
'restore it
.ShowHiddenText = lOriginalValue
Exit Function
End If

Next
isBlankSelection = True
'restore it
.ShowHiddenText = lOriginalValue
End With
End Function

I also ran inn to some other problems with how i deleted the last page as well as how i seleced the text on the last page.

So here is the code i ended up with for the function that deletes blank pages:


Public Function Remove_Blank_Pages_Macro()
Dim NumberOfPages As Long
Dim CurrentPage As Long
CurrentPage = 1
NumberOfPages = Selection.Information(wdNumberOfPagesInDocument)

Selection.GoTo What:=wdGoToSection, Which:=wdGoToFirst
Selection.ExtendMode = True
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Count:=1
For CurrentPage = 1 To NumberOfPages
If CurrentPage = NumberOfPages Then
Selection.EndKey Unit:=wdStory, Extend:=wdExtend
End If
Selection.ExtendMode = False
If isBlankSelection Then
If CurrentPage = NumberOfPages Then
Selection.Delete
Selection.ExtendMode = True
Selection.GoTo What:=wdGoToLine, Which:=wdGoToPrevious, Count:=1
If isBlankSelection Then
Selection.Delete
End If
Exit For
End If

Selection.Delete
Selection.ExtendMode = True
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Count:=1
Else
Selection.Collapse (wdCollapseEnd)
Selection.ExtendMode = True
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Count:=1
End If
Next CurrentPage
Selection.Collapse (wdCollapseEnd)
Selection.ExtendMode = False
End Function

The code is a bit messy and it's probably alot longer than it can be, but it seems to work. So i thought i would attach it here if someone else have this problem, as it might help them out. I'm going do some more tests on the macro at a later time, when i have some proper sized documents to test it on.

Now i guess im off to see if i can get my RD field search macro to work :hi:

Thank you again Frosty

-Even

[Ogion]

Hello. I'm not very good with English, please excuse me for that. I'm very thankful for this code.
Actually I'm Lotus Developer and recoded the code above for my needs in Lotus Script. But in some cases I catch a strange bug, when in some word document, that have some pages with landscape orientation (I hope you understand what I mean), after procedure complete, the pages with normal orientation changed it to landscape. The reason was that "Selection.Delete" deleted also some symbol (maybe a it was page break). So I modified procedure in such a way (it is Lotus Script, but translation to VBA is obvious):


Sub DeleteBlankPage( oWord As Variant, oWordDoc As Variant )
%REM
151013 ИИС удаление пустых страниц
051113 модифицировано для случая удаления лишних символов - меняется ориентация документа и
количество страниц в большую(!!!!) сторону
%END REM
On Error Goto errsub

Dim NumberOfPages As Long
Dim pages As Long
Dim CurrentPage As Long
Dim skip As Boolean
CurrentPage = 1
With oWord
NumberOfPages = .Selection.Information(wdNumberOfPagesInDocument)

Call .Selection.GoTo( wdGoToSection, wdGoToFirst )
.Selection.ExtendMode = True
Call .Selection.GoTo( wdGoToPage, wdGoToNext, 1 )
skip = False
For CurrentPage = 1 To NumberOfPages
If CurrentPage = NumberOfPages Then
Call .Selection.EndKey( wdStory, wdExtend )
End If
.Selection.ExtendMode = False
If isBlankSelection( oWord ) And Not skip Then
'Stop
If CurrentPage = NumberOfPages Then
Call .Selection.Delete()
.Selection.ExtendMode = True
Call .Selection.GoTo( wdGoToLine, wdGoToPrevious, 1)
If isBlankSelection( oWord ) Then
Call .Selection.Delete()
End If
Exit For
End If

Call .Selection.Delete()
'<051113> изменение развертки, удаление лишнего символа
pages = .Selection.Information(wdNumberOfPagesInDocument)
If pages > NumberOfPages Then ' странная ситуация, не так ли?
Call oWordDoc.Undo()
Call .Selection.MoveLeft( wdCharacter, 1, wdExtend )
Call .Selection.Delete()
skip = True
End If
'</051113>
.Selection.ExtendMode = True
Call .Selection.GoTo( wdGoToPage, wdGoToNext, 1)
Else
If skip Then
skip = False
End If
Call .Selection.Collapse (wdCollapseEnd)
.Selection.ExtendMode = True
Call .Selection.GoTo( wdGoToPage, wdGoToNext, 1)
End If
Next CurrentPage
Call .Selection.Collapse (wdCollapseEnd)
.Selection.ExtendMode = False
End With

endsub:
Exit Sub
errsub:
Msgbox "SL BarCodeLib >> Sub DeleteBlankPage >> Error " & Error & " on " & Erl
Resume endsub
End Sub

Part I added is marked by tag "<051113>", also condition " If isBlankSelection( oWord ) Then" is changed to " If isBlankSelection( oWord ) And Not skip Then" and so on.
Hope such modification is correct (worked in my case), I will be very thankful for your remarks.