I am importing plain text documents from a third party system that are long numbered lists of instructions. We put these documents into Word, make alterations, and upload them back to this third party system. But when we make alterations, this results in all our lists being out of sequence and we have to go back in and renumber them manually. I'd like to do this using VBA as we have hundreds of documents that will require these alterations.
Does anyone have any suggestions for how to go about this? I was thinking about stepping through each paragraph (each instruction is a paragraph), identifying which ones begin with numbers and thus need to be relabeled (some paragraphs are not numbered steps), deleting the existing number, replacing that deleted number with the next number in sequence.
I've found a few sites with code blocks that I can likely use, but wanted to see if I'm going about this the right way or if I should be trying another strategy, like changing each paragraph to automatic numbering as I step through the paragraphs.
For a simple series of numbered paragraphs that you might select, you could use code like:
Sub Demo()
With Selection.Range.ListFormat
.ApplyNumberDefault
.ApplyListTemplate ListTemplate:=ListGalleries(wdNumberGallery).ListTemplates(1), ContinuePreviousList:=True
End With
End Sub
Do be aware that the paragraph indenting may change and that such code will also number any unnumbered paragraphs in the selection So be careful with what you select.
This is a perfect toggle
Sub BulletNumeric()
'
' BulletNumeric Macro
'
'
Dim lfTemp As ListFormat
Dim intContinue As Integer
If Selection.Range.ListFormat.ListString = "1." Then
Selection.Style = "Bullet Numbered"
Else
Selection.Range.ListFormat.ApplyListTemplateWithLevel ListTemplate:= _
ListGalleries(wdOutlineNumberGallery).ListTemplates(7), _
ContinuePreviousList:=False, ApplyTo:=wdListApplyToWholeList, _
DefaultListBehavior:=wdWord10ListBehavior
End If
End Sub
First time you click it, it will give you 1. Next time it will simply continue from the one before.
Related
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
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
I'm trying to insert a formatted table that I have saved in word named "DV Table" as part of the building blocks using VBA. I need this table to be inserted at the 13th paragraph of the word document.
Here's my code below. The first 3 lines just sets the selection to be at the 12th paragraph and create a new paragraph (13) after that. The last line of code is to insert the table. But when I run this, it gives the error.
Compile Error: Sub or Function not defined
I guess that this is not the proper way of defining the location. Would like some help on this. Thanks.
ActiveDocument.Paragraphs(12).Range.Select
Selection.EndKey Unit:=wdLine
Selection.Paragraphs.Add
ActiveDocument.AttachedTemplate.BuildingBlockEntries("DV Table" _
).Insert Where:=Paragraphs(13).Range.Select, RichText:=True
The Where parameter requires a Range object. There are two problems with Paragraphs(13).Range.Select
it's a method - it's an action, selecting something, not returning an object
Paragraphs(13) isn't "fully qualified" - VBA doesn't know what it is/what is meant.
One possibility would be
ActiveDocument.Paragraphs(13).Range
Notice ActiveDocument. preceding Paragraphs: this "fully qualifies" Paragraphs(13) - it tells VBA to what that belongs. And, since Where requires a Range object, Paragraphs(13).Range should be a correct "target" (I have not tested your code).
Generally, it's preferable not to work with Selection, just with Range objects. There's usually no need to actually select something using VBA. An alternative to the code snippet in the question could be
Dim rng As Word.Range
Set rng = ActiveDocument.Paragraphs(13).Range
rng.Collapse wdCollapseEnd 'like pressing right-arrow for a selection
rng.InsertParagraphAfter
rng.Collapse wdCollapseStart ' like pressing left-arrow for a selection
'rng.Select ' for testing / demo purposes
ActiveDocument.AttachedTemplate.BuildingBlockEntries("DV Table" _
).Insert Where:=rng, RichText:=True
In this case, the selection in the document does not change. There's no screen flicker; and code executes more quickly. This way of working takes getting used to, but once one is familiar with it, it's much easier to recognize what the code should be doing... Selection is rather vague as to what is being manipulated, especially if there's a lot of code using it.
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.
I got the following code
=LEFT(A2, MIN(ROW(INDIRECT("1:"&LEN(A2)))+(((CODE(MID(UPPER(A2),
ROW(INDIRECT("1:"&LEN(A2))), 1))>64)*(CODE(MID(UPPER(A2),
ROW(INDIRECT("1:"&LEN(A2))), 1))<91))+
((CODE(MID(A2, ROW(INDIRECT("1:"&LEN(A2))), 1))>47)*
(CODE(MID(A2, ROW(INDIRECT("1:"&LEN(A2))), 1))<58)))*1E+99)-1)
I have this code and a few others, but how can I make it into a macro applicable to my entire workbook? I know its probably the same as a macro in terms of time, but I eventually want to loop it throughout a directory and would help automate a process. Is there a way to make this a macro for my workbook?
The crudest quickest way would be something like this:
Range("J2:J5000").Formula = "=LEFT(A2, MIN(ROW(INDIRECT(""1:""&LEN(A2)))+(((CODE(MID(UPPER(A2), ROW(INDIRECT(""1:""&LEN(A2))), 1))>64)*(CODE(MID(UPPER(A2), ROW(INDIRECT(""1:""&LEN(A2))), 1))<91))+((CODE(MID(A2, ROW(INDIRECT(""1:""&LEN(A2))), 1))>47)*(CODE(MID(A2, ROW(INDIRECT(""1:""&LEN(A2))), 1))<58)))*1E+99)-1)"
Which will put your exact formula in the range (and update itself according to the row reference). Obviously the reference to column J can be changed and the 5000 can be made dynamic using rows.count).end(xlup).row but without knowing which columns to play with I just had to take a stab at a crude solution.
However depending on what your "symbols" could be a solution using the split command would most likely be the better choice. Can you post more direction on this? Then I can edit this answer and add a code solution in for that for you.
Also include some sample data and expected results, maybe 10 rows worth to give a good set for testing
For an example of how the split command works select one of the cells with data in it that you need to split on the underscore and go to the debug window in the VBE (CTRL-G) and enter this (including the question mark) then press enter.
?split(Activecell.text,"_")(0)
Now update the 0 to 1 and press enter. This will show you how this command works, it splits a string to an array based on the delimiter you give it.
EDIT:
This code will do what you want, Notice how Split is being used.
Function GetFirstPart(SplitString As String)
Dim PosibleSplits As Variant, X As Long
PossibleSplits = Array("_", "+", "-")
For X = LBound(PossibleSplits) To UBound(PossibleSplits)
If Len(SplitString) <> Len(Split(SplitString, PossibleSplits(X))(0)) Then
GetFirstPart = Split(SplitString, PossibleSplits(X))(0)
Exit For
End If
Next
End Function
Use it by pasting the code into a module then in your sheet use it the same as any other formula =GetFirstPart(A1) where A1 has the string to split, drag down as far as your data goes.
You can add other delimiters in this line PossibleSplits = Array("_", "+", "-")