Question : Create bookmarks for certain sections

Dear Experts:

below macro performs the following:
Each section that contains the built-in heading style (wdStyleHeading2) gets bookmarked. The naming of the bookmarks is as follows: Section_Bookmark_i (i = sequential number).

This macro should be rewritten ...
... so that the bookmarks get named: Section_Bookmark_DE; Section_Bookmark_EN; Section_Bookmark_ES; Section_Bookmark_FR; Section_Bookmark_IT (that is the bookmark name 'Section_Bookmark_' gets appended by DE, EN, ES, FR, IT).

The following applies to all the documents against which this macro is run:
There are always exactly 5 sections that match the requirement...
... (ReDim HasHeading2(ActiveDocument.Sections.Count))

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

Regards, Andreas

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:



Sub BKMCreatePerSection()
    Dim HasHeading2() As Boolean
    Dim rng As Range
    Dim Sec As Section
    Dim para As Paragraph
    Dim i As Integer
    
    i = 1

Set rng = ActiveDocument.Range
 
 ReDim HasHeading2(ActiveDocument.Sections.Count)
    Set rng = ActiveDocument.Range
    With rng.Find
        .Format = True
        .Style = ActiveDocument.Styles(wdStyleHeading2)
        Do While .Execute(Wrap:=wdFindStop)
           HasHeading2(rng.Sections(1).Index) = True
        Loop
    End With
    For Each Sec In ActiveDocument.Sections
        Set rng = Sec.Range
        If HasHeading2(Sec.Index) Then
            ActiveDocument.Bookmarks.Add "Section_Bookmark_" & i, rng
            ActiveDocument.UndoClear
            i = i + 1
        End If
    Next Sec
        
End Sub

Answer : Create bookmarks for certain sections

That is a small tweak.

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:



Sub BKMCreatePerSection2()
    Dim rng As Range
    Dim Sec As Section
    Dim i As Integer
    Dim Suffix() As String
    Dim rngBookmark As Range
    
    Suffix = Split("DE,EN,ES,FR,IT", ",")
 
    For Each Sec In ActiveDocument.Sections
        Set rng = Sec.Range
        With rng.Find
            .Format = True
            .Style = ActiveDocument.Styles(wdStyleHeading2)
            Set rngBookmark = Sec.Range
            rngBookmark.MoveEnd wdCharacter, -1
            If .Execute Then
                ActiveDocument.Bookmarks.Add "Section_Bookmark_" & Suffix(i), rngBookmark
                i = i + 1
            End If
        End With
    Next Sec
        
End Sub