Automatically create bookmarks between the occurrence of user-definedstyle.

[andreas]

Dear Experts:

I got a document where the user-defined Paragraph Style
(Style_User_Defined) occurs between 2 and n-times.

I now would like to be able to automatically create bookmarks (naming
convention: bookmark_1 till bookmark_n) between these occurrences of
this user-defined style.

To be more precise:

Bookmark_1: Spans from FIRST occurrence of 'Style_User_Defined' till
the paragraph immediately preceding the SECOND occurrence of
'Style_User_Defined'.

Bookmark_2: Spans from SECOND occurrence of 'Style_User_Defined' till
the paragraph immediately preceding the THIRD occurrence of
'Style_User_Defined'.

And so forth till the end of the document. I hope this is feasible.

Help is much appreciated. Thank you very much in advance.

Regards, Andreas

 

[Doug Robbins - Word MVP]

The following might still need a bit of tweaking (change the style name to
suit - 2 places)

Dim prange As Range
Dim i As Long, j As Long
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("List Paragraph")
j = 0
With Selection.Find
Do While .Execute(FindText:="", Forward:=True, _
MatchWildcards:=False, _
Wrap:=wdFindStop, MatchCase:=False) = True
Here:
Selection.Collapse wdCollapseEnd
Set prange = Selection.Range
With prange
.End = ActiveDocument.Range.End
For i = 1 To .Paragraphs.Count
If .Paragraphs(i).Style = "List Paragraph" Then
j = j + 1
.Paragraphs(i).Range.Select
Selection.Collapse wdCollapseStart
Selection.Start = .Start
ActiveDocument.Bookmarks.Add "Bookmark_" & j,
Selection.Range
.Paragraphs(i).Range.Select
GoTo Here
End If
Next i
End With
Loop
End With


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com

 

[andreas]

The following might still need a bit of tweaking (change the style name to
suit - 2 places)

    Dim prange As Range
    Dim i As Long, j As Long
    Selection.HomeKey wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Style = ActiveDocument.Styles("List Paragraph")
    j = 0
    With Selection.Find
        Do While .Execute(FindText:="", Forward:=True, _
            MatchWildcards:=False, _
            Wrap:=wdFindStop, MatchCase:=False) = True
Here:
            Selection.Collapse wdCollapseEnd
            Set prange = Selection.Range
            With prange
                .End = ActiveDocument.Range.End
                For i = 1 To .Paragraphs.Count
                    If .Paragraphs(i).Style = "ListParagraph" Then
                        j = j + 1
                        .Paragraphs(i).Range.Select
                        Selection.Collapse wdCollapseStart
                        Selection.Start = .Start
                        ActiveDocument.Bookmarks.Add "Bookmark_" & j,
Selection.Range
                        .Paragraphs(i).Range.Select
                        GoTo Here
                   End If
                Next i
            End With
        Loop
    End With

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com














- Show quoted text -

Hi Doug,

great coding! It works as desired. Thank you very much for your
professional help.

There is one thing I would like to get changed if possible:
- the range of the bookmarks should include the user-defined style
which is searched at the beginning of your code, ...
.... to be more precise, the first bookmark should span from the first
occuurence of the user-defined style till the pararagraph that
immediately precedes the second occurrence of the user-defined style
and so forth.

Help is much appreciated. Thank you very much in advance. Regards,
Andreas

 

[Doug Robbins - Word MVP]

This should do that:

Dim prange As Range
Dim i As Long, j As Long
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("List Paragraph")
j = 0
With Selection.Find
Do While .Execute(FindText:="", Forward:=True, _
MatchWildcards:=False, _
Wrap:=wdFindStop, MatchCase:=False) = True
Here:
Set prange = Selection.Range
Selection.Collapse wdCollapseEnd
With prange
.End = ActiveDocument.Range.End
For i = 2 To .Paragraphs.Count
If .Paragraphs(i).Style = "List Paragraph" Then
j = j + 1
.Paragraphs(i).Range.Select
Selection.Collapse wdCollapseStart
Selection.Start = .Start
ActiveDocument.Bookmarks.Add "Bookmark_" & j,
Selection.Range
.Paragraphs(i).Range.Select
GoTo Here
End If
Next i
End With
Loop
End With


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com

 

[andreas]

This should do that:

   Dim prange As Range
    Dim i As Long, j As Long
    Selection.HomeKey wdStory
    Selection.Find.ClearFormatting
    Selection.Find.Style = ActiveDocument.Styles("List Paragraph")
    j = 0
    With Selection.Find
        Do While .Execute(FindText:="", Forward:=True, _
            MatchWildcards:=False, _
            Wrap:=wdFindStop, MatchCase:=False) = True
Here:
            Set prange = Selection.Range
            Selection.Collapse wdCollapseEnd
            With prange
                .End = ActiveDocument.Range.End
                For i = 2 To .Paragraphs.Count
                    If .Paragraphs(i).Style = "ListParagraph" Then
                        j = j + 1
                        .Paragraphs(i).Range.Select
                        Selection.Collapse wdCollapseStart
                        Selection.Start = .Start
                        ActiveDocument.Bookmarks.Add "Bookmark_" & j,
Selection.Range
                        .Paragraphs(i).Range.Select
                        GoTo Here
                   End If
                Next i
            End With
        Loop
    End With

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP, originally posted via msnews.microsoft.com










- Zitierten Text anzeigen -

Hi Doug,

superb job. It works great! Thank you very much for your professional
help.

Regards, Andreas