CODEWITHSUNDEEP
vbams-word
Aaron Thomas
Aaron Thomas

Reputation: 5281

Word VBA line length constraint

Goal: Using VBA in Word, I'd like to be able to type or paste text into a Word document, then make sure each line word wraps at a set amount of characters (typically 50, although this can change). I'd rather not use the ruler at the top of the document to manually adjust, especially when the fonts are not constant-width!

Failed Attempts: I've tried to use the following, resulting in an error "Value out of range":

Public Sub setWordsPerLine()
  ActiveDocument.PageSetup.CharsLine = 50
End Sub

I've also tried to insert a return character every 50 characters in a paragraph. However this is leading to a type mismatch error:

For Each pg In ActiveDocument.Paragraphs
b = pg.Range.Characters.Count
c = 50
If b > c Then
  For atch = c To pg.Range.Characters.Count Step c
    ActiveDocument.Range(pg.Range.Characters(atch)).InsertBefore (Chr(13))
  Next
End If
Next

Help Needed: Is there another method, property, or function that I should be using to do this? Paragraphs.RightIndent = x is based on points, not characters.

Upvotes: 1

Views: 3605

Answers (2)

Aaron Thomas
Aaron Thomas

Reputation: 5281

The other answer here by KazJaw works well, but I've modified to include some improvements, and wanted to post the modification in case someone else runs across this problem.

The improvements include:

  1. Better documentation of each step.
  2. Using a better ASCII control character so that paragraphs are better recognized.

  3. Using a more elegant method to determine if in the middle of a word, by replacing 

    If Len(Trim(ActiveDocument.Range(char_index - 1, char_index + 1).Text)) < 2 Then

    with 

    If ActiveDocument.Range(char_index).Text = " " Or _
ActiveDocument.Range(char_index).Text = "-" Then
  4. Hyphenated words are now able to be split correctly across lines. For example, "servo-valve" can now have "servo-" on one line, and "valve" at the beginning of the next line.

Here is the modified code, again thanks to KazJaw for the original solution.

Public Sub wrap_words()
'adapted from stackoverflow
'https://stackoverflow.com/a/19109049/2658159

Dim para_index As Paragraph
Dim para_index_numchars, char_index, para_index_start As Long

'set the max line length constraint
Const line_max As Byte = 50

'loop through each paragraph
For Each para_index In ActiveDocument.Paragraphs
  'find number of characters
  para_index_numchars = para_index.Range.Characters.Count

  'find the paragraph starting point
  para_index_start = para_index.Range.Start

  'if the paragraph has more than the predetermined amount of characters,
  If para_index_numchars > line_max Then

    'loop through each character starting with line_max position
    'and stepping by line_max position, to the end of the paragraph
    For char_index = (para_index_start + line_max) To _
    (para_index_start + para_index_numchars) Step line_max

      'if there is not a word in this position...
      If ActiveDocument.Range(char_index).Text = " " Or _
      ActiveDocument.Range(char_index).Text = "-" Then

        '...just insert new line mark
        ActiveDocument.Range(char_index, char_index).InsertAfter Chr(13)

      Else
        '... if there is a word, or a hyphenated word that
        'can be split, move to the beginnng of word or the
        'end of the hyphenated section.
        ActiveDocument.Range(char_index, char_index).Select
        Selection.MoveLeft unit:=wdWord, Count:=1

        'insert newline at the beginning
        Selection.InsertBefore Chr(13)

        'since a new paragraph created before the word,
        'the previous paragraph structure has changed.
        'change char_index to reflect that change.
        char_index = Selection.Start
      End If
    Next
  End If
Next

End Sub

Upvotes: 0

Kazimierz Jawor
Kazimierz Jawor

Reputation: 19067

I have improved the second solution of yours which is now working fine. (I made some test with simple lorem ipsum document). 

Sub qTest_line()
    Dim PG As Paragraph
    Dim B, C, ATCH, S

        For Each PG In ActiveDocument.Paragraphs
            B = PG.Range.Characters.Count
            S = PG.Range.Start
        C = 50
        If B > C Then
          For ATCH = (S + C) To (S + B) Step C
            'check the position
            If Len(Trim(ActiveDocument.Range(ATCH - 1, ATCH + 1).Text)) < 2 Then
                'just insert new line mark
                ActiveDocument.Range(ATCH, ATCH).InsertAfter Chr(11)
            Else
                'move to the beginnng of word
                ActiveDocument.Range(ATCH, ATCH).Select
                Selection.MoveLeft wdWord
                Selection.InsertBefore Chr(11)
                ATCH = Selection.Start
            End If

          Next
        End If
        Next
End Sub

Upvotes: 1

Related Questions