remove carriage return after deleting items

[kerenlu]

I am deleting programmatically items from Table Of Contents but the carriage return are not deleted so I am receiving a table of content with white spaces.

I working on word 2007 Here is the full code:
On Error GoTo ErrHndl

Dim i As Integer
Dim iStep As Integer
Dim ipos As Integer
Dim ipos_2 As Integer
Dim cntTables As Integer
Dim myFontSize As Integer
Dim cntWords As Integer
Dim cntEnglishWords As Integer
Dim cntContentsFields As Integer
Dim cntContentsSeif As Integer
Dim lneFeedPos As Integer
Dim strContents As String
Dim bgnAppendixArray() As Integer
Dim arrIndex As Integer

With ActiveDocument
If .Range.LanguageID = wdEnglishUS Then
gDocLang = wdEnglishUS
Else
gDocLang = wdHebrew
End If
End With

If ActiveDocument.TablesOfContents.Count >= 1 Then
ActiveDocument.TablesOfContents(1).Range.Select
ActiveDocument.TablesOfContents(1).Update
Else
Selection.EndKey Unit:=wdLine
Selection.TypeParagraph
Selection.Range.Style = ActiveDocument.Styles(wdStyleNormal)
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
myFontSize = Selection.Font.SizeBi + 1

If gDocLang = wdEnglishUS Then
Selection.Font.Size = 14
Selection.TypeText Text:="Index"
Else
Selection.TypeText Text:="???? ????????"
End If

Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
Selection.Font.SizeBi = Selection.Font.SizeBi + 2
Selection.Font.Bold = True
Selection.Font.BoldBi = True
Selection.EndKey Unit:=wdLine
Selection.TypeParagraph
Selection.Range.Style = ActiveDocument.Styles(wdStyleNormal)
Selection.TypeParagraph
With ActiveDocument
.TablesOfContents.Add Range:=Selection.Range, RightAlignPageNumbers:= _
True, UseHeadingStyles:=True, UpperHeadingLevel:=1, _
LowerHeadingLevel:=1, IncludePageNumbers:=True, AddedStyles:="", _
UseHyperlinks:=True, HidePageNumbersInWeb:=True, UseOutlineLevels:= _
False
.TablesOfContents(1).TabLeader = wdTabLeaderSpaces
End With
End If

For cntTables = 1 To ActiveDocument.TablesOfContents.Count
ActiveDocument.TablesOfContents(cntTables).Range.Select
Selection.Range.Style = ActiveDocument.Styles("TOC 1")

If gDocLang = wdEnglishUS Then Selection.LtrPara
Next

ActiveDocument.TablesOfContents(1).Range.Select
cntContentsFields = Selection.Fields.Count
iStep = 2
arrIndex = 0
cntContentsSeif = 0
strContents = Selection.Fields(1).Result
lneFeedPos = InStr(1, Selection.Fields(1).Result, Chr(13))
Do While lneFeedPos > 0
cntContentsSeif = cntContentsSeif + 1
strContents = Mid(strContents, lneFeedPos + 1)
lneFeedPos = InStr(1, strContents, Chr(13))
Loop

If cntContentsSeif * 2 <> cntContentsFields - 1 Then GoTo DocumentfromW2000

For i = 4 To cntContentsFields - 1 Step 2
iStep = i
ipos = InStr(1, Selection.Fields(iStep).Result, Chr(46))
ipos_2 = InStr(1, Selection.Fields(iStep - 2).Result, Chr(46))

If ipos <= 1 Then
MsgBox CONTENT_ERR_MSG, vbInformation
GoTo DocumentfromW2000
Else
If Not IsNumeric(Mid(Selection.Fields(iStep).Result, 1, ipos - 1)) Then
MsgBox CONTENT_ERR_MSG, vbInformation
GoTo DocumentfromW2000
End If
End If

On Error GoTo DocumentfromW2000


If CInt(Mid(Selection.Fields(iStep).Result, 1, ipos - 1)) < CInt(Mid(Selection.Fields(iStep - 2).Result, 1, ipos_2 - 1)) Then
ReDim Preserve bgnAppendixArray(arrIndex)
bgnAppendixArray(arrIndex) = iStep
arrIndex = arrIndex + 1
End If
Next

If arrIndex > 1 Then
For i = cntContentsFields To bgnAppendixArray(1) Step -1
Selection.Expand wdSentence
Selection.Fields(i).Delete
Next
End If

If arrIndex > 0 Then
For i = bgnAppendixArray(0) - 1 To 2 Step -1
Selection.Expand wdSentence
Selection.Fields(i).Delete
Next
End If
Exit Sub
DocumentfromW2000:
Exit Sub
ErrHndl:
MsgBox "ERROR: " + CStr(Err.Number) + " - " + Err.DESCRIPTION, vbCritical

[fumei]

Your use of Selection (without any comments) makes it a bit difficult to understand what you are trying to do.

Why are you deleting anything from the ToC, rather than a simple update?
If ActiveDocument.TablesOfContents.Count >= 1 Then
ActiveDocument.TablesOfContents(1).Range.Select
ActiveDocument.TablesOfContents(1).Update
Why select and then update?

[kerenlu]

Because I have this scenario:
1. Subject 1
2. Subject 2
3. Subject 3
1. Subject 11
2. Subject 22
3. Subject 33
1. Subject 111
2. Subject 222

And I want to display only Subject 11 - Subject 22. In other words only the second group of subjects. What do you think?

[macropod]

Hi kerenlu,

Your approach is doomed to failure - you cannot permanently delete individual items from a TOC field. As soon as anything causes the TOC to update, the deleted items will be restored. All your macro demonstrates is a failure to learn how TOC fields work. From what you've described, no vba code is required!!

If you want a TOC that only reflects the headings used for part of the document, bookmark that part and apply the bookmark switch for that bookmark to the TOC field. Likewize, if you only want particular heading Styles (or other Styles) to be included in the TOC, then use the appropriate switches.

[kerenlu]

Thank you for your reply.
Can you please be more specify or give me an example.

Keren

[macropod]

Hi Keren,

How about having a read of what's in these links, giving their advice a try, then coming back if you have any problems (with a sample document to demonstrate the issues you're having):
http://office.microsoft.com/en-us/word-help/field-codes-toc-table-of-contents-field-HP005186201.aspx
http://word.mvps.org/FAQs/Formatting/TOCSwitches.htm

[fumei]

In particular, read the MVPS article, and the section "A partial table of contents". It sounds like what you want to do.

[kerenlu]

Thank you both for your advice. , It helped a lot.
I still didn't find a way to set my TOC the settings I defined.
Meaning I define bookmarks for a certain subject but I didn’t find the way to set the switch definition to my TOC programmatically via vba.
Can you help me?

[macropod]

If you can't define your TOC with those tools, nothing you can do in vba is going to improve things, for the reasons I've already given. If the need arises, you can even have more than one TOC, each referring to a different bookmarked range and different heading levels. Why do you want to do any of this programmatically?

[fumei]

You are not doing it through VBA. You are doing through the field codes.

[macropod]

One could create a TOC field programatically, with the relevant switches...

[fumei]

Sorry, missed the update from Paul. I agree. WHY do you want to do this programmatically? I would forget about this route, VBA is not going to help.

As you can read from the articles, you can do what you appear to want without any VBA.

[kerenlu]

I defined a new style named “TOC Header” and mark the relevant paragraphs with that style. I have additional paragraphs which are marked with “Heading 1” style.
In my vba code I tried to manipulate TOC to display only the paragraphs mark with “TOC Header” style but it displays all paragraphs including “Heading 1”.
Here is my code:
With ActiveDocument
.TablesOfContents.Add Range:=Selection.Range, RightAlignPageNumbers:= _
True, UseHeadingStyles:=False, IncludePageNumbers:=True, AddedStyles:= _
"TOC Header,1", UseHyperlinks:=True, HidePageNumbersInWeb:= _
True, UseOutlineLevels:=False
.TablesOfContents(1).TabLeader = wdTabLeaderSpaces
.TablesOfContents.Format = wdIndexIndent
End With

[macropod]

Try:
Dim TOC As TableOfContents
With ActiveDocument
Set TOC = .TablesOfContents.Add(Range:=.Range(0, 0), RightAlignPageNumbers:=True, _
UseHeadingStyles:=False, IncludePageNumbers:=True, AddedStyles:="TOC Header", _
UseHyperlinks:=True, HidePageNumbersInWeb:=True, UseFields:=True)
TOC.TabLeader = wdTabLeaderSpaces
.TablesOfContents.Format = wdIndexIndent
End With
Mind you, if you created the appropriate TOC in your document's template, there'd be no need to create it in code.

[kerenlu]

Thank you very much. It works :-)