Justify All Text except in line broken by a line break - vba

I'm new here so thank you in advance for your patience. Also, I'm not a native English speaker so some things might get lost in translation.
I found this wonderful vba macro to "Justify all text is Microsoft Word" [from Alvin567] and you all 1 and it works just as planned.
I would like to adapt it so that it doesn't justify paragraphs that has Shift+Enter (linebreak I think) in my document. I can't seem to find how to refer to that specific character, since it's different than "Chr(13)".
I'm usually good at adapting codes from the recording tool or find online what I'm looking for even though I never learned it through any courses, but with this one, I can't seem to figure it out on my own.
Any help would be greatly appreciated.
So here is the code :
Sub JustifyAllTheText(control As IRibbonControl) 'Don't forget to link it with RibbonX
On Error Resume Next
Dim para As Paragraph
Dim searchRange As Range
Set searchRange = Selection.Range
searchRange.End = ActiveDocument.Content.End
For Each para In searchRange.Paragraphs
If para.Range.Font.Size = 10 Then
'If para.Range.Font.ColorIndex = wdBlack Then 'I don't need it but kept it just in case
If Not para.Range.InlineShapes.Count > 0 Then
'If Not para.Range.IsEndOfRowMark = True Then 'Added line to test linebreak but doesn't work to made into text
If Not para.Range = vbLf Then
If Not para.Range.Information(wdWithInTable) Then
para.Range.ParagraphFormat.Alignment = wdAlignParagraphJustify
End If
End If
End If
End If
Next para
End Sub
Thanks!

You cannot justify lines ending in manual line breaks via any of the paragraph justification options. Instead, you need to modify a compatibility setting, thus:
Sub Demo()
Application.ScreenUpdating = False
ActiveDocument.Compatibility(wdExpandShiftReturn) = True
Application.ScreenUpdating = True
End Sub
Any lines you don't want to have justified that way will then require a tab to be inserted before the manual line break.
Moreover, you should not force the justification of paragraphs via code like:
para.Range.ParagraphFormat.Alignment = wdAlignParagraphJustify
That is liable to lead to document bloat and, potentially, corruption. Rather, you should modify the underlying paragraph Style - which also means making the change once for all affected paragraphs throughout the document.

Thank you all for your help.
Since it wasn't a good thing to justify that way, I manage to get my result with a mix of a Find and replace macro to get rid of the Shift+Enter and they I modified the Normal style to justify it. Put them both together and added a button on my RibbonX custom tab. All in all, everthing ends up as it should be and we save time with the help of a button.
Thank you!

You can check for
If InStr(para.Range.Text, vbVerticalTab) = 0 Then
If you replace your current codeline If Not para.Range = vbLf Then with this line, your macro will exlude paragraphs that have a soft return from applying wdAlignParagraphJustify
vbVerticalTab is equal to chr(11) which is in Word the "character" for Shift+Enter

Related

VBA Macro to check addition of word before, after with misspelled word for a suggested correction

Use case: I’m using voice dictation software to make notes to myself that I paste into MS-Word. The software does a decent job but mangles some words resulting in a lot of spelling errors. Category 1 of those are basically homonyms, mostly technology terms. I built a nice VBA macro that uses find and replace, pulling the homonym and the desired correction from a spreadsheet. Works very well. Category 2 is harder to solve and comprises mostly of misspellings due to random spaces being inserted by the software into an otherwise properly spelled word. There’s no definitive pattern that I see, like always at syllable break or between double letters, but it often occurs where one or more syllables is a properly spelled word, and a different syllable is severed, and that piece alone is not a valid word. e.g. transcribes “Cat egory” versus “Category.” The correct piece can be the first or second half.
Code needs to:
run spell check over the ActiveDocument Range
find the next spelling error
look at the word before, check spelling of it plus the misspelled word, if spelled correctly, accept
else look at the word after, check spelling of it plus the misspelled word, if spelled correctly, accept
continue to next error
Result would be something like this:
co ding to correct spell ing err ors due to spa cing ->
coding to correct spelling errors due to spacing
I know how to invoke spellcheck, cycle through the range, get the spelling suggestions, etc. but I’m struggling on how to identify the previous and next word, then run spellcheck again inside of the original spellcheck session.
Sub SpellCheck()
Dim Rng As Range, oSuggestions As Variant
For Each Rng In ActiveDocument.Range.SpellingErrors
With Rng
If .GetSpellingSuggestions.Count > 0 Then
' TBD
End If
End With
Next
End Sub
Any suggestions? I’m willing to accept some level of false positives or words that have to be corrected manually. Just something that fixes the above representative examples would be huge. Thanks much!
Perhaps:
Sub SpellCheck()
Dim Rng As Range, oSuggestions As Variant
For Each Rng In ActiveDocument.Range.SpellingErrors
With Rng
If .Characters.First.Previous = " " Then
.Characters.First.Previous.Delete
.Start = .Words.First.Start
If .SpellingErrors.Count > 0 Then
ActiveDocument.Undo
If .Characters.Last.Next = " " Then
.Characters.Last.Next.Delete
.End = .Words.Last.End
If .SpellingErrors.Count > 0 Then ActiveDocument.Undo
End If
End If
End If
End With
Next
End Sub

Batch add formatted autocorrects with VBA in Word

I use a long Excel spreadsheet containing incorrect and correct terms to check consistency between documents (e.g. anti-citrullinated is always hyphenated). I've added quite a few of these as autocorrect entries via the AutoCorrect Options feature in Word but it's time-consuming .
I came across the following code that will add long lists of autocorrects.
Sub BatchAddAutoCorrectEntries()
Dim objTable As Table
Dim objOriginalWord As Cell
Dim objOriginalWordRange As Range
Dim objReplaceWordRange As Range
Dim nRowNumber As Integer
Set objTable = ActiveDocument.Tables(1)
nRowNumber = 1
For Each objOriginalWord In objTable.Columns(1).Cells
Set objOriginalWordRange = objOriginalWord.Range
objOriginalWordRange.MoveEnd Unit:=wdCharacter, Count:=-1
Set objReplaceWordRange = objTable.Cell(nRowNumber, 2).Range
objReplaceWordRange.MoveEnd Unit:=wdCharacter, Count:=-1
AutoCorrect.Entries.Add Name:=objOriginalWordRange.Text, Value:=objReplaceWordRange.Text
nRowNumber = nRowNumber + 1
Next objOriginalWord
MsgBox ("All autocorrect items in the table1 are added.")
End Sub
It doesn't preserve any formatting: super- or subscripts, etc. Formatting autocorrect entries are stored in the Normal.dotm file and not in the regular .acl file so I haven't been able to figure out a way around this.
In a similar post, someone suggested a Find and Replace macro but Find and Replace doesn't allow me to replace with super- or subscripts.
There are two methods of adding Auto Correct Entries, Add and AddRichText. It is this second one that you use for formatted entries.
When faced with an issue like this my first resort is to check the Object Brower in the VBA editor (press F2 to display) to see what methods and properties may be available. My next step is to look them up in the VBA technical reference, aka Help, to check the usage.
If the problem is just sub/superscribt, then you could use uni-codes. Those are also available in autocorrect. Fx writing the unicodes ₁₂₃₄₅₆₇₈₉ instead of using formating on a normal 2. Most (but not all) characters exist in super and sub unicode.
The program is not working. It is giving an error message
Compile Error Expected Function or Variable
It is showing the following line as error
Autocorrect.Entries.Add Name:=objOriginalWordRange.Text, Value:=objReplaceWordRange.Text

Getting the previous Word in VBA using selection.previous wdword, 1 bug

I'm trying to write a macro to type the previous word at the cursor.
the problem is when i'm using "selection.previous wdword, 1" to get the previous character, it sometimes get the 2 previous characters and it seems like a bug. when i press "delete" button it works and it is very strange to me.
I'd glad if you help.
my ultimate goal is to create a calendar converter inside word using this code.
here is how i test it:
MsgBox Selection.previous(unit:=wdWord, Count:=1)
it is the same using next :
MsgBox Selection.Next(unit:=wdWord, Count:=1)
instead of next word, sometimes it returns the word after!
For example this is the text: during the flight on 21/3/1389
If the cursor is right after the 1389, msgbox selection.previous(1,1) would show "/"; if the cursor is after a space after 1389 it shows "1389". The problem is, I think, the space. My question is if there is any alternative to read the previous word instead of this command (Selection.previous(unit:=wdWord, Count:=1))
Word is not buggy - it's behaving as designed. Something has to tell Word where words start and end. When the cursor stands to the right of a space it's (quite logically) at the beginning of the next word. So going one word back is going to pick up 1389 instead of /.
You can work around this in your code. I'm sure there's more than one way to do it, but the following works for me in a quick test:
Sub GetPrevWord()
Dim rngSel As word.Range, rngPrev As word.Range
Set rngSel = Selection.Range
Set rngPrev = rngSel.Duplicate
rngPrev.MoveStart wdCharacter, -1
If Left(rngPrev.Text, 1) = " " Then
rngPrev.Collapse wdCollapseStart
End If
rngPrev.Select
MsgBox Selection.Previous(unit:=wdWord, Count:=1)
rngSel.Select
End Sub
What it's doing is using two Ranges: one to hold the original selection, the other to work with (rngPrev). rngPrev is extended backwards by one character and this character is evaluated. If it's a space then rngPrev is collapsed to its starting point. (Think of it like pressing the left arrow key of a selection.) In any case, rngPrev is selected and your MsgBox code is run. Finally, the original range is selected again.

Word document not reflecting change visually after vba code is used to indent a paragraph

I have a simple vba code in Word 2010:
Sub IncreaseIndent()
For Each p In Selection.Paragraphs
p.LeftIndent = p.LeftIndent + InchesToPoints(0.25)
p.FirstLineIndent = InchesToPoints(-0.25)
Next
End Sub
It works great, does what I need, and I have it associated to a shortcut key. But I'm trying to figure out one last glitch it has. When I use it, the paragraph indents, but it's not visually refreshed properly in the document. I have to scroll so that the text goes out of view, and then scroll it back. (Any action that makes Word re-render works, like switching to another program whose window is on top of Word, and back again.) After that, the paragraph looks as it should.
I'm thinking I'm missing some kind of p.Refresh / Re-render / Recalc command, but don't know what that is. Anyone know how to cause the refresh in the vba code?
Thanks,
Sandra
I was not able to replicate what you describe, but there is a .ScreenRefresh method which might do the trick.
https://msdn.microsoft.com/en-us/library/office/ff193095(v=office.15).aspx
Note: in the example code provided at MSDN (and as modified slightly, below), when I test it the toggling ScreenUpdating property has no effect, it always appears to update for me when I run it, even when set explicitly to False
Sub t()
Dim rngTemp As Range
Application.ScreenUpdating = False
Set rngTemp = ActiveDocument.Range(Start:=0, End:=0)
rngTemp.InsertBefore "new"
Application.ScreenRefresh
Application.ScreenUpdating = True
End Sub

Insert text after numbers and before words in a Word hierarchical heading

I am working my way through two books (Roman's Writing Word Macros, Mansfield's Mastering VBA for MS Office). In my work environment, I use both Word 2007 and Word 2010.
My issue is that I want to use VBA to insert a very brief amount of standardized text before the English-language string in my numbered hierarchical headings. For instance, I have:
1.1.1 The Quick Brown Fox.
What I want is:
1.1.1 (XXxx) The Quick Brown Fox.
I guess my most basic issue is that I don't know how to approach the situation. I have hierarchical headings yet I don't know how to say, in effect, "Go to each hierarchical heading regardless of level. Insert yourself in front of the first English language word of the heading. Paste the text "XXxx" in front of the first word in the heading. Go on to the next heading and all remaining headings and do the same. My document is over 700 pages and has hundreds of hierarchical headings.
I see that paragraphs are objects and that hierarchical headings are paragraphs. However, I can't see any way to make VBA recognize what I am talking about. I haven't been able to use Selection approaches successfully. I've tried using the Range approach but just have not been able to phrase the VBA code intelligently. I haven't been able to specify a range that includes all and only the hierarchical headings and, especially, I don't understand how to get the insertion to happen in front of the first English-language word of the heading.
I have just begun to look at using Bookmarks. However, don't bookmarks require me to go to every heading and enter them? I may as well just paste my content if that is the case. I'm stumped. It is interesting that in no way, as might have been expected, does this appear to be a simple matter
Assuming you are using Word's outline levels (I think this is what you mean by hierarchical headings), you can check a paragraph for this state. For example, assuming I have a paragraph in my document that has the Heading 1 style applied to it:
Sub PrintHeadings()
Dim objDoc as Document
Dim objPara as Paragraph
Set objDoc = ActiveDocument
For each objPara in objDoc.Content.Paragraphs
If objPara.OutlineLevel <> wdOutlineLevelBodyText then
Debug.Print objPara.Range.Text
End If
Next objPara
End Sub
This code would print the contents of any paragraph that has an outline level above body text to the VBA Immediate Window. There are other approaches as well; you could use Find and Replace to search for each of the Outline Levels. This gives you a bit less control; you'd want your change to be something that could be encapsulated in a Word Find and Replace. But, it would be faster if you have a long document and not too many heading levels. A basic example:
Sub UnderlineHeadings()
Dim objDoc as Document
Set objDoc = ActiveDocument
With objDoc.Content.Find
.ClearFormatting
.ParagraphFormat.OutlineLevel = wdOutlineLevel1
With .Replacement
.ClearFormatting
.Font.Underline = wdUnderlineSingle
End With
.Execute Forward:=True, Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceAll
End With
End Sub
That would underline all of your text of Outline Level 1.
Perhaps that will get you started.
I asked this question some months ago: "My issue is that I want to use VBA to insert a very brief amount of standardized text before the English-language string in my numbered hierarchical headings." By "numbered hierarchical headings" I meant Word multilevel lists. The answers I received were appreciated but did not respond effectively to my question or guide me to a resolution. I pass this along in the hope it may be of use to others.
First, the "number" part of the Word heading is irrelevant. In writing your code, there is NO need to think of a "number" portion and a "text" portion of the heading. I was afraid that any text I was trying to insert would be inserted BEFORE the multilevel numbering rather than BEFORE the English language text. The multilevel numbering is apparently automatically ignored. Below are two solutions that worked.
This first macro succeeded in producing the desired result: 1.1.1 (FOUO). I used this macro to create individual macros for each order of heading. I haven't learned how to combine them all into one macro. But they work individually (but not without the flaw of taking too much time ~5 to 10 minutes for a complex, paragraph-heavy 670 page document).
Public Sub InsertFOUOH1()
Dim doc As Document
Dim para As Paragraph
Dim paraNext As Paragraph
Dim MyText As String
Dim H1 As HeadingStyle
Set doc = ActiveDocument
Set para = doc.Paragraphs.First
Do While Not para Is Nothing
Set paraNext = para.Next
MyText = "(U//FOUO) "
If para.Style = doc.Styles(wdStyleHeading1) Then
para.Range.InsertBefore (MyText)
End If
Set para = paraNext
Loop
End Sub
THIS WORKS ON ALL FIRST ORDER HEADINGS (1, 2, 3 ETC.)
I used the macro below to add my security marking all body paragraphs:
Public Sub InsertFOUObody()
'Inserts U//FOUO before all body paragraphs
Dim doc As Document
Dim para As Paragraph
Dim paraNext As Paragraph
Dim MyText As String
Set doc = ActiveDocument
Set para = doc.Paragraphs.First
Do While Not para Is Nothing
Set paraNext = para.Next
MyText = "(U//FOUO) "
If para.Style = doc.Styles(wdStyleBodyText) Then
para.Range.InsertBefore (MyText)
End If
Set para = paraNext
Loop
End Sub
These macros are running slowly and, at the end, generating Error 28 Out of stack space errors. However the error is displayed at the end of running the macros and after the macros have successfully performed their work.