VBA Word find text with a special style in heading level-CodePudding

EDIT all my Headings are in a heading style

roughly speaking, i am looking for the headings level range, and count if or how often the text with the style (bullet) occurs

EDIT Looking for the possibility to search in headings for a text with a special style and if possible to count how many times it occurred in this heading level. for an example
3. Ü3
3.1 Ü3.1
3.1.1 Ü3.1.1
3.1.1.1 Ü3.1.1.1

text i not searching (standard style)

• text with style i searching for (bullet style) <<<

text i not searching (standard style)
4. Ü4
4.1 Ü4.1
4.2 Ü4.2
text i not searching (standard style)
4.2.1 Ü4.1.1
4.2.2 Ü4.1.2
• text with style i searching for (bullet style) <<<
• text with style i searching for (bullet style) <<< (headin3-style range (looking for this range))
5. Ü5 ( Heading1-style (new range))

It would help me if I could get the range in heading-level2/3/4 and search for the style and maybe count how many times it appears there

until now i have only managed in heading-style-1 which takes the whole range from for example 4.
4. Ü4 (heading1-style range start)
4.1 Ü4.1
4.2 Ü4.2
text i not searching (Standard style)
4.2.1 Ü4.1.1
4.2.2 Ü4.1.2
• text with style i searching for (bullet style) <<<
• text with style i searching for (bullet style) <<< ( All heading1-style range - end )
and then search via tags and not via special style...

Public Function HeadingMeasuresCount(capter As String) As Integer

Dim cc As ContentControl
Dim cc2 As ContentControl
Dim cc3 As ContentControl
Dim rngÜ As Range
Dim teststring As String
Dim counterHeadings As Integer
Dim arrSplitrngÜTest() As String
Dim oDoc As Document
Set oDoc = ActiveDocument

For Each cc In ActiveDocument.ContentControls
If cc.Tag = "cc_Heading1" Then
If cc.Title <> "" Then


cc.Range.Select

Set rngÜ = Selection.Bookmarks("\HeadingLevel").Range


teststring = rngÜ.Paragraphs(1).Range.ListFormat.ListString

If Left(teststring, 1) = capter Or Left(teststring, 2) = capter Then

counterHeadings = 0

For Each cc2 In ActiveDocument.ContentControls
If cc2.Tag = "cc_NrMaßnahme" Then
If InStr(rngÜ.Text, cc2.Range.Text) > 0 Then

counterHeadings = counterHeadings   1
End If
End If
Next cc2
HeadingMeasuresCount = counterHeadings
Exit Function
End If


End If ' title
End If ' heading
Next cc

HeadingMeasuresCount = counterHeadings
End Function

CodePudding user response：

It doesn't look like Word can find a character/paragraph style embedded in a paragraph. i.e if I have a paragraph of text in Heading 1 style and I format a word of that heading as Body Text 3 (a combined character/paragraph style) with italic attribute added, I can see that the word is italic but the Bofy Text 3 style can't be found.

However Word can find one or more font attributes for the 'Body Text 3' style, specifically in this case the italic text.

The following code may be of help

Option Explicit


Sub test()

    ' Body Text 3 has also had the italic formatting added to the style.
    CountStyleInHeadings ("Body Text 3")
End Sub
Public Function CountStyleInHeadings(ByVal ipStylename As String) As Variant

    Dim myCounts As Variant
    ReDim myCounts(1 To 9)
    
    Dim myPara As Variant
    For Each myPara In ActiveDocument.StoryRanges(wdMainTextStory).Paragraphs
    
        Dim myRange As Range
        Set myRange = myPara.Range
        myRange.Select
        If myPara.OutlineLevel <> wdOutlineLevelBodyText Then
        
            If StyleNameFound(myRange, ipStylename) Then
            
                myCounts(myPara.OutlineLevel) = myCounts(myPara.OutlineLevel)   1
                
            End If
            
        End If
            
    Next
    
End Function


Public Function StyleNameFound(ByRef ipParagraph As Range, ByRef ipStylename As String)
    Debug.Print ipParagraph.Text
    Debug.Print ipStylename
    With ipParagraph.Find
    
        .ClearFormatting
        .Font.Italic = True
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        .Execute
    End With
    
    Debug.Print ipParagraph.Find.Found
    StyleNameFound = ipParagraph.Find.Found
End Function

CodePudding user response：

Here's some code to get you started. It returns the heading level, heading text & bullet text for each paragraph in the 'Bullet' style.

Sub GetBulletHeadings()
Application.ScreenUpdating = False
Dim RngHd As Range
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = ""
    .Style = "Bullet"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = False
  End With
  Do While .Find.Execute
    Set RngHd = .Paragraphs(1).Range.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
    MsgBox Right(RngHd.Paragraphs.First.Range.Style, 1) & vbCr & RngHd.Paragraphs.First.Range.Text & vbCr & .Text
    .Collapse wdCollapseEnd
  Loop
End With
Set RngHd = Nothing
Application.ScreenUpdating = True
End Sub