Hello Everyone!
I have executed the below code for its purpose "To delete blank pages" and it works correctly.
The problem is that in some pages which are Blank it do not delete them.
Now ,the point is that these Blank pages looks like ""blank" but in fact they have spaces on it,and that is the reason that the below code do not delete them.
Please,If someone could help me to add a condition into the code to check first for that blank charachters or that blank spaces that are in some pages.Delete them ,and then delete the blank pages.
Thank you ,
Erjola
Dim d = GetDocument(handle,documentname)
Dim a As Object = GetInstance(handle)
Dim oDoc = d
Dim para As Object
Dim i As Integer=1
Dim oRng As Object
Dim lParas As Long
Dim lEnd As Long
Dim lDeleted As Long
Dim wdGoToPage As Integer
Dim wdGoToAbsolute As Integer
Const wdCharacter As Integer = 1
lParas = oDoc.Paragraphs.Count
Do While i = i + 1
oDoc.Selection.GoTo (What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=i)
oRng = a.Selection.Range
oRng.End = a.Selection.Bookmarks("\Page").Range.End
oRng.Select
lEnd = lEnd + oRng.Paragraphs.Count ' Keep track of how many processed
For Each para In oRng.Paragraphs
If Len(para.Range.Text) = 1 Then
para.Range.Delete
lDeleted = lDeleted + 1
Else ' If not blank, then delete o more in this page!
Exit For
End If
Next para
' Calc how many paragraphs processed
If lDeleted + lEnd >= lParas Then ' If more that we started with, let's call it a day!
Exit Do
End If
Loop
lParas = oDoc.Paragraphs.Count ' Total paragraph count
lDeleted = 0 ' reset stuff - in case
lEnd = 0
i = 0
Do
i = i + 1
a.Selection.GoTo (What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=i)
oRng = a.Selection.Range
oRng.End = a.Selection.Bookmarks("\Page").Range.End
oRng.Select
lEnd = lEnd + oRng.Paragraphs.Count
If oRng.Paragraphs.Count = 1 Then
If oRng.Paragraphs(1).Range.Text = Chr(12) & Chr(13) Then
oRng.Paragraphs(1).Range.Delete
lDeleted = lDeleted + 1
i = i - 1
'ElseIf Len(oRng.Paragraphs(1).Range.Text) = 1 Then
' oRng.Paragraphs(1).Range.Delete
' lDeleted = lDeleted + 1
' i = i - 1
End If
End If
If lEnd >= lParas Then
Exit Do
End If
Loop
' Finally!!! Deal with the lingering final page-break!
a.Selection.GoTo (What:=wdGoToPage, Which:=wdGoToAbsolute, Count:=999 ) ' Go to Last Page.
oRng = a.Selection.Range ' Select the end..
oRng.MoveStart (wdCharacter, -3 ) ' Backup 3 characters
If Left(oRng.Text, 2) = Chr(13) & Chr(12) Then ' Should be 13+12
oRng.Text = "" ' Remove that thingy!
End If
para = Nothing
oDoc = Nothing
------------------------------
Erjola Mema
------------------------------
