Remove Trailing blank spaces in endnotes / footnotes in word docum

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

Sita - 28 Jan 2008 20:54 GMT

Hi,

We are having an issue while processing endnotes/footnotes in a word
document to remove any extra spaces (trailing) at the end of each endnote /
footnote.

We are using following piece of code to replace trailing spaces in the
endnote. Although there are no trailing spaces in the endnote,
allText.Find.Execute is returning true and its not coming out of the while
loop for the end note processing.

Also, even if i open the word document search for " ^p" in endnotes and try
to replace, it does not let me do that.

Const wdReplaceAll = 2
Const wdFindContinue = 1
For Each en In objDoc.EndNotes
allText = en.Range
If allText.Find.Execute (" ^p", False, False, False, False, False, True,
wdFindContinue, False, "^p", wdReplaceAll) = True Then
isReturn = True
End If

Really appreciate your help.

Thanks,
Sita

Reply to this Message

David Sisson - 28 Jan 2008 21:43 GMT

Sub TrimEndnotes()
Dim aDoc As Document
Dim Rng As Range
Dim NumEN As Integer

Set aDoc = ActiveDocument
NumEN = ActiveDocument.Endnotes.Count

For A = NumEN To 1 Step -1
Set Rng = aDoc.Endnotes(A).Range
Rng = RTrim(Rng)
Next A

End Sub

Sub TrimFootNotes()
Dim aDoc As Document
Dim Rng As Range
Dim NumEN As Integer

Set aDoc = ActiveDocument
NumEN = ActiveDocument.Footnotes.Count

For A = NumEN To 1 Step -1
Set Rng = aDoc.Footnotes(A).Range
Rng = RTrim(Rng)
Next A

Reply to this Message

Sita - 28 Jan 2008 22:45 GMT

Thanks David for the solution. The given code has removed trailing blank
spaces in the foot / end notes.

But trailing tab spaces still exist. Do we need to handle trailing tab
spaces separately? If so, any suggestions?

> Sub TrimEndnotes()
> Dim aDoc As Document
[quoted text clipped - 23 lines]
> Rng = RTrim(Rng)
> Next A

Reply to this Message

David Sisson - 29 Jan 2008 02:56 GMT

>But trailing tab spaces still exist. Do we need to handle trailing tab
>spaces separately? If so, any suggestions?

This seems to work and covers multiple tabs in one endnote.

Replace Endnotes with Footnotes to correct those as well.

Sub TrailingTabs()
Dim aDoc As Document
Dim Rng As Range
Dim NumEN As Integer
Dim A As Integer

Set aDoc = ActiveDocument
NumEN = ActiveDocument.Endnotes.Count

For A = NumEN To 1 Step -1
Set Rng = aDoc.Endnotes(A).Range
Do
With Rng.Find
.Text = Chr(9) & Chr(13)
.Replacement.Text = Chr(13)
.Forward = True
.Wrap = wdFindContinue
End With
Rng.Find.Execute Replace:=wdReplaceAll
Loop Until Rng.Find.Found = False
Next A

End Sub

Reply to this Message

Sita - 29 Jan 2008 17:42 GMT

Below code is giving compilation error as i am using Office 2003

So, I have tried with a different code (below), although it doesnt replace
anything but it returns true.

Dim allText, isReturn
Set allText = en.Range
allText.Find.Replacement.ClearFormatting
If allText.Find.Execute (ChrW(9) & ChrW(13), False, False, False, False,
False, True, wdFindContinue, False, ChrW(13), wdReplaceAll) = True Then
isReturn = True
End If

any suggestions?

> >But trailing tab spaces still exist. Do we need to handle trailing tab
> >spaces separately? If so, any suggestions?
[quoted text clipped - 26 lines]
>
> End Sub

Reply to this Message

David Sisson - 29 Jan 2008 18:54 GMT

> Below code is giving compilation error as i am using Office 2003
>
[quoted text clipped - 10 lines]
>
> any suggestions?

Based on what you've posted, en isn't defined, hence, allText can't be
defined.

It would help if you posted the error and which line is highlighted.

If you just need to set isReturn when found, put in the following line
in my last code.

> > Rng.Find.Execute Replace:=wdReplaceAll

If Rng.Find.Found then isReturn = True

> > Loop Until Rng.Find.Found = False

Reply to this Message

Sita - 29 Jan 2008 20:32 GMT

Hi David,

Following is total piece of code i am trying to run on word document.

Const wdFormatDocument = 0
Const wdReplaceAll = 2
Const wdFindContinue = 1

Dim objWord ,objDoc, docFile

docFile = docFile = WScript.Arguments( 0 )
Call processEndNotes

Sub processEndNotes
    dim foundSpaces
    dim en
    On Error Resume Next

    Set objWord = CreateObject("Word.Application")
    objWord.Visible = False
    Set objDoc = objWord.Documents.Open (docFile)

    WScript.Echo "processing endnotes.."
    For Each en In objDoc.EndNotes
        WScript.Echo "processEndNotes() : en : " & en.index
        foundSpaces = executeRemoveSpaces(en.Range)
        Do While foundSpaces
            foundSpaces = executeRemoveSpaces(en.Range)
        Loop
        en.Range = RTrim(en.Range)
        trailingTabs(en.Range)
    Next

    objDoc.SaveAs docFile, , wdFormatDocument

    objDoc.Close
    Set objDoc = Nothing
    objWord.Quit
    Set objWord = Nothing

    If Err.Number <> 0 Then
        WScript.echo "Removing spaces/tabs was not successful"
        WScript.echo "ERROR:Number=" & Err.Number
        WScript.echo "ERROR:Description=" & Err.Description
        Err.Clear
        closeDoc
        Wscript.Quit 0
    End If

End Sub

Function trailingTabs(range)
    Do
    With range.Find
        .Text = Chr(9) & Chr(13)
        .Replacement.Text = Chr(13)
        .Forward = True
        .Wrap = wdFindContinue
    End With
    range.Find.Execute Replace = wdReplaceAll
    Loop Until range.Find.Found = False
End Function

Function executeRemoveSpaces(range)
dim allText, isReturn
Set allText = range
allText.Find.Replacement.ClearFormatting
isReturn = allText.Find.Execute (" ", False, False, False, False,
False, True, wdFindContinue, False, " ", wdReplaceAll)
executeRemoveSpaces = isReturn
Set allText = Nothing
End Function

_________________________________________

Following compilation error message is showing while trying to run.

C:\WKCode\Workspace\webtop-ltbna\scripts\processEndNotes2.vbs(57, 29)
Microsoft VBScript compilation error: Expected statement

line # 57 is "range.Find.Execute Replace:=wdReplaceAll"

position # 29 is ":"

I have removed : (colon) and tried to run, it gave following error message :

Microsoft (R) Windows Script Host Version 5.6
Copyright (C) Microsoft Corporation 1996-2001. All rights reserved.

processing endnotes..
Removing items was not successful
ERROR:Number=424
ERROR:Description=Object required

***** script completed *****

> > Below code is giving compilation error as i am using Office 2003
> >
[quoted text clipped - 22 lines]
> If Rng.Find.Found then isReturn = True
> > > Loop Until Rng.Find.Found = False

Reply to this Message

David Sisson - 29 Jan 2008 22:20 GMT

I am not familier with running from WScript, but Range is a reserve
word in Word.

foundSpaces = executeRemoveSpaces(en.Range)

would be correct, but...

> Function trailingTabs(range)
> Do
[quoted text clipped - 7 lines]
> Loop Until range.Find.Found = False
> End Function

Might cause trouble.

Try
Function trailingTabs(Rng)
Do
With Rng.Find
.Text = Chr(9) & Chr(13)
.Replacement.Text = Chr(13)
.Forward = True
.Wrap = wdFindContinue
End With
Rng.Find.Execute Replace = wdReplaceAll
Loop Until Rng.Find.Found = False
End Function

Anyone else have a suggestion?

Reply to this Message

Helmut Weber - 31 Jan 2008 14:17 GMT

Hi everybody,

see: http://tinyurl.com/2885um

Somewhat adapted to endnotes:

Sub Macro3ab()
Dim rDcm As Range
Dim rPrg As Paragraph
Dim rEnd As Endnote
Set rDcm = ActiveDocument.Range
' not to mention sections
' could be processed as well
For Each rEnd In rDcm.Endnotes
For Each rPrg In rEnd.Range.Paragraphs
With rPrg.Range.Characters
While .Last.Previous = Chr(32) _
Or .Last.Previous = Chr(9)
.Last.Previous = ""
Wend
End With
Next
Next
End Sub

Don't delete anything, because of possible autocorrection issues.
And don't replace a paragraph mark by chr(13),
because this might ruin formatting and replace
a paragraph mark by a pure chr(13).

In addition, there a some kinds of spaces
ordinary ascW(32)
non-breaking ascW(160)
em-space ascW(8195)
en-space ascW(8194)
¼-em-space ascW(8197)

Signature

Greetings from Bavaria, Germany
Helmut Weber, MVP WordVBA
"red.sys" & chr(64) & "t-online.de"
Word 2002, Windows 2000 (german versions)

Reply to this Message