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 ...
Doug_Robbins_Word_MVP's avatar
Doug_Robbins_Word_MVP
MVP

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

    • Mehmetbukum's avatar
      Mehmetbukum
      Copper Contributor
      Oct 24, 2022
      When i run the code, it goes into an infinite loop and crashes the word software.
      • Doug_Robbins_Word_MVP's avatar
        Doug_Robbins_Word_MVP
        MVP
        Oct 24, 2022

        Mehmetbukum Use

        Dim RngFound As Range, DocRange As Range, DocRangeOriginal As Range
Dim i As Long, j As Long
Set DocRange = ActiveDocument.Range
i = DocRange.Paragraphs.Count
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
Selection.Find.Style = "farsca_cumle"
With Selection.Find
    Do While .Execute(FindText:="", MatchWildcards:=False, Wrap:=wdFindStop, 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
j = DocRange.Paragraphs.Count
DocRange.Select
Selection.Collapse wdCollapseEnd
Selection.MoveStart wdParagraph, i - j
Selection.Style = "farsca_cumle"

         

         

        I have added code to format the text added to the end of the document in "farsca_cumle" style.

Resources