Find and format lines of verse

RobiNew · #1 11-04-2023, 01:13 AM

I have a tentative code to find consecutive one-line paragraphs (lines of verse) and to replace Chr(13) with (11) at the end of the line. I have uploaded a test docx. Can someone help? Thanks!

Code:

Sub LinesOfVerse()
    For Each Paragraph In ActiveDocument.Paragraphs
TypePara = "No"
NrPara = NrPara + 1
If Paragraph.Range.ComputeStatistics(wdStatisticLines) = 1 Then
    Paragraph.Range.Select
    Paragraph.Range.Characters.Last.Text = vbNullString
    Paragraph.Range.Characters.Last.Text = Chr(11)
    Paragraph.Range.Characters.Last.Text = vbNullString
    Paragraph.Range.Characters.Last.Text = Chr(11)
    TypePara = "Yes"
End If
If Paragraph.Range.ComputeStatistics(wdStatisticLines) = 1 _
And TypePara = "Yes" Then
    Paragraph.Range.Select
    Paragraph.Range.Characters.Last.Text = vbNullString
    Paragraph.Range.Characters.Last.Text = Chr(11)
    Paragraph.Range.Characters.Last.Text = vbNullString
    Paragraph.Range.Characters.Last.Text = Chr(11)
'    MsgBox "Check!"
End If
    Next
     End Sub

vivka · #2 11-04-2023, 04:34 AM

Hi, RobiNew! La prochaine has come. Regarding you code, I'd replace vbnull with chr(32) or " " to insert space. Next, 1) do you want to merge a one-line para with the next one-line para or with all one-line paras that follow or 2) do you want to merge a one-line para with any following para?

vivka · #3 11-04-2023, 05:02 AM

RobiNew, is this is what you want to get?

RobiNew · #4 11-04-2023, 07:23 AM

No, Vivka, that is not what I want to get. No merging of paragraphs, but replacing of "^p" with "^l" in consecutive one-line paragraphs, as in the new docx I have posted. Thanks!

vivka · #5 11-04-2023, 08:15 AM

RobiNew, here you are, enjoy it!

Code:

Sub OneLiners()
'In selection, replace Chr(13) with Chr(11) between all consecutive one-line paras.

Dim oRng
Application.ScreenUpdating = False
Set oRng = selection.range
    For Each Para In oRng.Paragraphs
        If Para.range.End >= oRng.End Then Exit Sub
        If Para.range.ComputeStatistics(wdStatisticLines) = 1 And _
            Para.Next.range.ComputeStatistics(wdStatisticLines) = 1 Then
            Para.range.Characters.Last.text = Chr(11)
            Do While Para.Next.range.ComputeStatistics(wdStatisticLines) = 1
                Para.range.Characters.Last.text = Chr(11)
            Loop
        End If
    Next
Application.ScreenUpdating = True
Set oRng = Nothing
End Sub

RobiNew · #6 11-04-2023, 08:39 AM

Thanks a lot, Vivka! But what I need is a bit more sophisticated. The macro should first detect one or more consecutive one-line paragraphs and then operate with your code. In other words, it should operate in the absence of a specific selection. Is that possible? I know you can do it. Thanks!

vivka · #7 11-04-2023, 08:56 AM

RobiNew, replace

Set oRng = selection.range
with
Set oRng = ActiveDocument.range

and the macro will work on the whole doc. Or maybe I don't quite understand your point.

RobiNew · #8 11-04-2023, 10:00 AM

Thanks a lot, Vivka! It's perfect now. Why are you still labelled as "Beginner"?!

vivka · #9 11-04-2023, 10:37 AM

You are welcome, RobiNew! I'm not a professional. It's my hobby and I'm still learning. This forum is my university.
I realise that my macros are not perfect, but practice makes perfect.
The following code is two-lines shorter:

Code:

Sub OneLiners()
'In selection, replace Chr(13) with Chr(11) between all
'consecutive one-line paras.

Dim oRng
Application.ScreenUpdating = False
Set oRng = ActiveDocument.range
    For Each Para In oRng.Paragraphs
'Prevent returning an error if the next para is nothing:
        If Para.range.End >= oRng.End Then Exit Sub
        If Para.range.ComputeStatistics(wdStatisticLines) = 1 Then
            Do While Para.Next.range.ComputeStatistics(wdStatisticLines) = 1
                Para.range.Characters.Last.text = Chr(11)
            Loop
        End If
    Next
Application.ScreenUpdating = True
Set oRng = Nothing
End Sub

RobiNew · #10 11-04-2023, 11:12 AM

Anyway, you're certainly not a beginner! And many thanks for the new code!

RobiNew · #11 11-06-2023, 01:45 AM

Hi, Vivka! I'm using your code here above, but I need to insert two conditions:
-- skip if paragraph is centered
-- and skip if paragraph contains a numeral
I've tried the two sets of code here below, but the second condition does not work.

Para.Range.Select
If Para.Range.ParagraphFormat.Alignment <> wdAlignParagraphCenter _
And Mid(Para.Range, 1) <> "^#" Then

Para.Range.Select
If Para.Range.ParagraphFormat.Alignment <> wdAlignParagraphCenter _
And Not IsNumeral(Mid(Para.Range, 1)) Then

Can you help? Thanks!

vivka · #12 11-06-2023, 12:29 PM

Hi, RobiNew! The following macro skips one-liners clusters if their first para is center-aligned or has a digit:

Code:

Sub OneLiners()
'In selection, replace Chr(13) with Chr(11) between all
'consecutive one-line paras, if....

Dim oRng
Application.ScreenUpdating = False
Set oRng = ActiveDocument.range
    For Each Para In oRng.Paragraphs
        If Para.range.End >= oRng.End Then Exit Sub
        If Para.range.ParagraphFormat.Alignment = wdAlignParagraphCenter _
            Or Para.range Like "*[0-9]*" Then GoTo nexxt
        If Para.range.ComputeStatistics(wdStatisticLines) = 1 Then
            Do While Para.Next.range.ComputeStatistics(wdStatisticLines) = 1
                Para.range.Characters.Last.text = Chr(11)
            Loop
        End If
nexxt:
    Next
Application.ScreenUpdating = True
Set oRng = Nothing
End Sub

If you want to see if other paras meet the requirements, place the If statement in other place (experiment with it).

RobiNew · #13 11-07-2023, 01:33 AM

Thanks a lot, Vivka! Everything seems OK now. I am really grateful.

vivka · #14 11-07-2023, 06:39 AM

You are welcome, RobiNew!

gmaxey · #15 11-07-2023, 12:22 PM

Vivka,

I don't know if any of us here are professionals or if any of us have stopped learning from others. RobiNew, Vivka status flag is based solely on post count.

I looked at the code you posted Vivka and have the following comments/suggestions:
-I try to avoid GoTo
-While what you posted seems to work for the OP, it seems that if a one line paragraph was nested with other one line paragraphs (not the first) then the OP stated conditions were not handled.
-Rest of comments are inline with the code.

Code:

Sub OneLinersII()
'In selection, replace Chr(13) with Chr(11) between all
'consecutive one-line paras, if....
Dim oPar As Paragraph 'If you dim one variable, why don't you dim all variables?
Dim oRng As Range 'You declared the range object as a variant.  Why not as a range?
  Application.ScreenUpdating = False
  Set oRng = ActiveDocument.Range
  For Each oPar In oRng.Paragraphs
    If oPar.Range.End >= oRng.End Then Exit For 'If you Exit Sub then you won't execute your ScreenUpdating line
    If Not oPar.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter _
      And Not oPar.Range Like "*[0-9]*" Then
      If oPar.Range.ComputeStatistics(wdStatisticLines) = 1 Then
        Do While oPar.Next.Range.ComputeStatistics(wdStatisticLines) = 1 _
          And Not oPar.Range.Next.ParagraphFormat.Alignment = wdAlignParagraphCenter _
          And Not oPar.Next.Range Like "*[0-9]*"
          oPar.Range.Characters.Last.Text = Chr(11)
        Loop
      End If
    End If
  Next oPar
  Application.ScreenUpdating = True
  Set oRng = Nothing: Set oPar = Nothing
lbl_Exit:
  Exit Sub
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Format Word Document - Remove timestamps on individual lines	lbeck	Word	4	06-21-2023 12:47 PM
How do I format indented bulleted lines??? HELP PLEASE!!!	nicholeproffitt	Word	1	02-05-2015 05:42 PM
Print table and on verse form vba	LaercioNB	Excel	1	08-09-2013 06:03 PM
How to remove unwanted lines - I cannot even find how/where they are inserted!	nickib	Word	7	08-09-2013 06:01 AM
Find and Replace multiple lines/paragraphs	jcw	Word	1	11-18-2011 11:47 AM