![]() |
#1
|
|||
|
|||
![]() 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:
Code:
.Expand Unit:=wdLine 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 |
Thread Tools | |
Display Modes | |
|
![]() |
||||
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 |
![]() |
qaz1 | Word | 1 | 07-25-2015 04:13 AM |
![]() |
dmarie123 | Word VBA | 10 | 07-20-2015 12:16 AM |
![]() |
bracketandquotes | Word VBA | 17 | 02-16-2015 03:51 PM |
![]() |
Jamal NUMAN | Word | 1 | 07-07-2011 11:53 PM |