Forum Discussion

Mehmetbukum's avatar
Mehmetbukum
Copper Contributor
Oct 24, 2022

get list a spesicif style text

The sentences written in the Arabic alphabet marked in the photo were created with the style called "farsca_cumle". Is it possible to list only the sentences defined with this style at the end of the active Document?

 

this code cant work well

 

sub listit()
Dim isfound As Boolean
Dim i As Integer
i = 1
Selection.Find.Style = ActiveDocument.Styles("farsca_cumle")
With Selection.Find
    .Text = ""
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=1
isfound = True
While isfound
    With Selection.Find
        .Execute
        If .Found = True Then
                ActiveDocument.Content.InsertAfter Text:=i & " " & Selection.Text
                i = i + 1
            Selection.MoveRight Unit:=wdCharacter, Count:=1
        Else
                 isfound = False
        End If
    End With
Wend
End sub

 

 

  • Doug_Robbins_Word_MVP's avatar
    Doug_Robbins_Word_MVP
    MVP
    Oct 24, 2022

    Mehmetbukum Try using

     

    Dim RngFound As Range, DocRange As Range
Set DocRange = ActiveDocument.Range
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
Selection.Find.Style = "farsca_cumle"
With Selection.Find
    Do While .Execute(FindText:="", MatchWildcards:=False, Wrap:=wdFindContinue, Forward:=True) = True
        Set RngFound = .Selection.Range
        If RngFound.End < DocRange.End Then
            ActiveDocument.Range.InsertAfter RngFound.Text & vbCr
            Selection.Collapse wdCollapseEnd
        Else
            Exit Sub
        End If
    Loop
End With
    • Mehmetbukum's avatar
      Mehmetbukum
      Copper Contributor
      Oct 24, 2022
      i think before the loop (do while - loop) starts, it should go to the beginning of the document and when the end of the document is reached, the loop should be terminated. Otherwise, it will enter an infinite loop. we must edit code
      • Doug_Robbins_Word_MVP's avatar
        Doug_Robbins_Word_MVP
        MVP
        Oct 24, 2022

        Mehmetbukum Sorry, the code should have been

         

        Dim RngFound As Range, DocRange As Range
Set DocRange = ActiveDocument.Range
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
Selection.Find.Style = "farsca_cumle"
With Selection.Find
    Do While .Execute(FindText:="", MatchWildcards:=False, Wrap:=wdFindContinue, Forward:=True) = True
        Set RngFound = Selection.Range
        If RngFound.End < DocRange.End Then
            ActiveDocument.Range.InsertAfter RngFound.Text & vbCr
            Selection.Collapse wdCollapseEnd
        Else
            Exit Sub
        End If
    Loop
End With

         

        This If...then...Else...EndIf construction will cause the code to terminate when it comes to the end of the original text in the document

         

        If RngFound.End < DocRange.End Then
             ActiveDocument.Range.InsertAfter RngFound.Text & vbCr
             Selection.Collapse wdCollapseEnd
        Else
             Exit Sub
        End If

Resources