Microsoft Office Forums

Go Back   Microsoft Office Forums > Microsoft Word > Word VBA

Reply
 
LinkBack Thread Tools Display Modes
  #1  
Old 10-12-2018, 07:35 AM
Peterson Peterson is offline Windows 10 Office 2016
Advanced Beginner
 
Join Date: Jan 2017
Posts: 31
Peterson is on a distinguished road
Default How to resize a paragraph range to include just a single line of text

I frequently work on documents with strict page limits. To meet these limits, I condense text to nix "runts," those one- or two-word ends of paragraphs that appear on a single line. Meanwhile, I need to return all of the lines in the paragraph to no condensing, except for the one or two lines that, when condensed, cause the runt to disappear.



The process: I'm writing a macro to automate the process, as follows:
  • Select an entire paragraph.
  • Condense it (in 0.05-pt increments, up to 0.2) until the number of lines in the paragraph decreases by one.
  • Select the first line in the paragraph and reset the spacing to 0.
  • If the number of lines in the paragraph increases, that is, if the runt re-appears, condense the selected line's text until the number of lines goes down by 1.
  • Go to the next line of text and repeat.
The problem: I get runtime error 4120 (Bad parameter) here:

Code:
.Expand Unit:=wdLine
How do I set the range to just a single line of text and then reset it to subsequent lines?

Thanks

Code:
Sub SqueezeText_1012()

    ' rngEndPara identifies the end of the paragraph, then passes it to another
    ' variable (lngLastLineNum); this is so we can determine if a condensed
    ' paragraph has shrunk by a line
    Dim rngEndPara As Range
    ' rngPara is used to apply the condensing and subsequent line-by-line
    ' resetting to no condensing
    Dim rngPara As Range
    Dim lngLastLineNum As Long
    ' Used to increment the condense loop by 0.05 intervals
    Dim iCondense As Single
        
    ' Set the initial range as the current cursor position (Selection.Range)
    Set rngPara = Selection.Range
    ' Expand the range to include the entire paragraph
    rngPara.Expand Unit:=wdParagraph
    
    ' If there is already condensed/expanded text in the paragraph, set it to
    ' none; do this early on, or else the end point might be set on one line,
    ' then, after nixing consensing, the end point is on a different line
    rngPara.Font.Spacing = 0
    
    ' Set the initial range as the current cursor position (Selection.Range)
    Set rngEndPara = Selection.Range
    ' Expand the range to include the entire paragraph
    rngEndPara.Expand Unit:=wdParagraph

    ' Collapse the rngEndPara range to the end of the range so we can eventually
    ' get the line number it's on
    With rngEndPara
        .Collapse direction:=wdCollapseEnd
        ' Because collapsing a paragraph range sets the range to AFTER the
        ' paragraph mark, back it up a character
        .MoveEnd Unit:=wdCharacter, Count:=-1
    End With
    
    ' Set this last-paragraph-line marker
    lngLastLineNum = rngEndPara.Information(wdFirstCharacterLineNumber)
    
    ' Condense the full paragraph range:
    
    ' Set the incrementer to -0.05 (point)
    iCondense = -0.05
    ' Now loop until either the paragraph shrinks one line or we hit a max.
    ' 0.2 pt condensed
    Do Until rngEndPara.Information(wdFirstCharacterLineNumber) = lngLastLineNum - 1 Or rngPara.Font.Spacing = -0.2
        rngPara.Font.Spacing = iCondense ' Condense in -0.05 increments
        iCondense = iCondense + -0.05
    Loop

    ' If after condensing 0.2 point the paragraph's total line count doesn't
    ' decrease, then the paragraph isn't a candidate for condensing, so reset
    ' the spacing to 0.
    If lngLastLineNum = rngEndPara.Information(wdFirstCharacterLineNumber) Then
        rngPara.Font.Spacing = 0
    End If
    
    ' Set the range to just a single line; start at the first line of the paragraph
    With rngPara
        .Collapse direction:=wdCollapseStart
        .Expand Unit:=wdLine
    End With
        
End Sub
Reply With Quote
  #2  
Old 10-12-2018, 02:59 PM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 18,680
macropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to beholdmacropod is a splendid one to behold
Default

Try the following approach. As coded, the macro tests every multi-line paragraph and, if that paragraph's last line is less than 1/6 of the print width, condenses the paragraph font in 0.05pt increments till the line wrapping disappears. Each line is then re-set and, if it wraps, is recondensed as much as needed. Condensing never exceeds 1pt; you can change that by changing the -1 in the code. You can also change the 1/6 criteria to another value (e.g. 1/5 or 1/7) by changing the 6 in the code.
Code:
Sub MinimizeLastLineWraps()
Application.ScreenUpdating = False
Dim Sctn As Section, Para As Paragraph, Rng As Range, RngTmp As Range, sWdth As Single, sSpc As Single
For Each Sctn In ActiveDocument.Sections
  'Loop through each Section
  With Sctn
    'Get the Section print width
    With .PageSetup
      sWdth = .PageWidth - .LeftMargin - .RightMargin - .Gutter
    End With
    'Loop through each Paragraph in the Section
    For Each Para In .Range.Paragraphs
      With Para
        Set Rng = .Range
        With Rng
          'Reset the font spacing to 0
          sSpc = 0: .Font.Spacing = sSpc
          'Check whether the paragraph has more than one line; skip one-liners.
          If .Characters.First.Information(wdVerticalPositionRelativeToTextBoundary) <> _
            .Characters.Last.Information(wdVerticalPositionRelativeToTextBoundary) Then
            'Check how far along the line the last character is; we only want to process short last lines.
            'Compress paragraphs with short last lines, up to 1pt.
            Do While .Characters.Last.Information(wdHorizontalPositionRelativeToTextBoundary) < sWdth / 6
              'If the compression exceeds 1pt, re-set & give up.
              If sSpc = -1 Then
                sSpc = 0: .Font.Spacing = sSpc: Exit Do
              End If
              sSpc = sSpc - 0.05: .Font.Spacing = sSpc
            Loop
            If sSpc <> 0 Then
              'Re-check whether the paragraph has more than one line; skip one-liners.
              If .Characters.First.Information(wdVerticalPositionRelativeToTextBoundary) <> _
                .Characters.Last.Information(wdVerticalPositionRelativeToTextBoundary) Then
                'Decompress each line, then apply minimal re-compression to restore then to one line each
                .Collapse wdCollapseStart
                Set RngTmp = .Duplicate
                Do While .End < Para.Range.End
                  Set RngTmp = RngTmp.GoTo(What:=wdGoToLine, Which:=wdGoToNext)
                  .End = RngTmp.Start
                  sSpc = 0: .Font.Spacing = sSpc
                  Do While .Characters.First.Information(wdVerticalPositionRelativeToTextBoundary) <> _
                    .Characters.Last.Information(wdVerticalPositionRelativeToTextBoundary)
                    sSpc = sSpc - 0.05: .Font.Spacing = sSpc
                  Loop
                  .Collapse wdCollapseEnd
                Loop
              End If
            End If
          End If
        End With
      End With
    Next
  End With
Next
Application.ScreenUpdating = True
End Sub
__________________
Cheers,
Paul Edstein
[MS MVP - Word]

Last edited by macropod; 10-12-2018 at 03:26 PM. Reason: Code refinement
Reply With Quote
  #3  
Old 10-15-2018, 07:38 AM
Peterson Peterson is offline Windows 10 Office 2016
Advanced Beginner
 
Join Date: Jan 2017
Posts: 31
Peterson is on a distinguished road
Default

Wow, this is terrific -- thank you, Paul!


It never occurred to me that you could determine the spatial position of text on a page -- cool stuff!
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Highlighting applied to range ending in a paragraph continues to apply to text added after Peterson Word VBA 2 10-08-2018 02:50 PM
Pasted text becomes single long line qaz1 Word 1 07-25-2015 04:13 AM
Extract Line of Text w/ specific characters up to the paragraph character, send to Excel dmarie123 Word VBA 10 07-20-2015 12:16 AM
macro to add brackets to each line and add single quotes to each word in the line bracketandquotes Word VBA 17 02-16-2015 03:51 PM
what is the professional way to include an equation in a paragraph? Jamal NUMAN Word 1 07-07-2011 11:53 PM


All times are GMT -7. The time now is 12:53 AM.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2018, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2011, Crawlability, Inc.
MSOfficeForums.com is not affiliated with Microsoft