select hyperlink from TOC and delete range of text it points to

[Satya]

Hi

I have a TOC containing hyperlinks to various chapters and sections in the
document.
I want to select hyperlink from TOC and delete range of text it points to.
Then update the TOC accordingly for page no and serial no for hyperlinks.

Another acceptable solution would be
select hyperlink from TOC and replace range of text it points to by a const
string say confidential.
Then update the TOC accordingly for page no .

Thanks for the help in advance.

Thanks
Satya

 

[Jean-Guy Marcil]

Hi

I have a TOC containing hyperlinks to various chapters and sections in the
document.
I want to select hyperlink from TOC and delete range of text it points to.
Then update the TOC accordingly for page no and serial no for hyperlinks.

Another acceptable solution would be
select hyperlink from TOC and replace range of text it points to by a const
string say confidential.
Then update the TOC accordingly for page no .

Just to make sure...

You have a TOC that points to headings in your document.

You want a macro that will delete all the text between a heading (the one
currently selected in the TOC) and the next heading that appears in the TOC?

 

[Satya]

Thanks Jean,

Yes I am looking for that kind of macro.
The TOC is linked to headings only.
Deleting all text between selected heading and the next heading as per TOC,
we can replace the text as well between two headings and then update the page
numbers.

 

[Jean-Guy Marcil]

Thanks Jean,

Yes I am looking for that kind of macro.
The TOC is linked to headings only.
Deleting all text between selected heading and the next heading as per TOC,
we can replace the text as well between two headings and then update the page
numbers.

Try this (this code assumes that you have only one TOC in the document and
that it was built using the hyperlink feature to allow navigation to the
headings in the document from the headings in the TOC):

Option Explicit

Sub test()

Dim rgeTOC As Range
Dim rgeDel As Range
Dim boolLastHeading As Boolean

'Make sure cursor is within TOC
If Not Selection.Paragraphs(1).Range _
.InRange(ActiveDocument.TablesOfContents(1).Range) Then
MsgBox "Select a heading within the TOC.", _
vbExclamation, "Not TOC"
Exit Sub
End If

boolLastHeading = False

'In case more than one TOC heading is selected, _
collpase to beginning of selection
Selection.Collapse wdCollapseStart

Set rgeTOC = Selection.Range.Paragraphs(1).Range

'If last heading is selected set flag, in fact we have _
to select the penultimate paragraph because the _
last paragraph is the lone ¶ that follows the TOC
If rgeTOC = ActiveDocument.TablesOfContents(1).Range _
.Paragraphs.Last.Range.Previous.Paragraphs(1).Range Then
boolLastHeading = True
End If

rgeTOC.Hyperlinks(1).Follow
'Collapse to beginning of heading
Selection.Collapse wdCollapseStart

Set rgeDel = Selection.Range

If Not boolLastHeading Then
rgeTOC.Next.Paragraphs(1).Range.Hyperlinks(1).Follow
'Collapse to beginning of heading
Selection.Collapse wdCollapseStart
Else
Selection.EndKey wdStory
End If

With rgeDel
.End = Selection.Range.Start
.Delete
End With

ActiveDocument.TablesOfContents(1).Update

rgeTOC.Select

End Sub


If you want to overwrite the range with some text, replace the last With
block with this:

With rgeDel
.End = Selection.Range.Start
.Text = "CONFIDENTIAL" & Chr(13)
.Style = "Normal"
End With

 

[Satya]

Thanks a lot Jean, You are simply amazing, I will try this and let you know
the results.

 

[Satya]

Hi Jean

It works like a charm. You are a genius. Thanks a lot for your help.

Thanks once again
Satya

 

[Jean-Guy Marcil]

Hi Jean

It works like a charm. You are a genius. Thanks a lot for your help.

Thanks once again

Glad I could help...