I have a Word document with blocks of text marked with styles called "Princple" and "BusinessRule". These blocks of text are scattered throughout the document. I would like to find and copy these blocks to a separate document in the order in which they appear. The code I am using is:
Dim SelStyle As String
'SelStyle = "Principle"
SelStyle = "BusinessRule"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Style = SelStyle
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Copy
Windows("Document1").Activate
Selection.TypeParagraph
Selection.PasteAndFormat (wdFormatPlainText)
Selection.TypeParagraph
Windows("mainDoc.docx").Activate
Selection.MoveRight Unit:=wdCharacter, Count:=1
As you see, this is a manual process: first un-comment the Principle, extract all of those, then comment Princple and uncomment BusinessRule. Not great. Is there any way to search for .Style="Principle" or .Style="BusinessRule" so I get them all in sequence? (And, secondarily, if you have a suggestion for looping through the whole document to do this, I would be additionally grateful. :-))
Thanks - Bill
Why not store the values in an array?
Sub Sample()
Dim SelStyle(1) As String
SelStyle(0) = "Principle"
SelStyle(1) = "BusinessRule"
For i = 0 To 1
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Style = SelStyle(i)
'
'~~> Rest of your code
'
Next i
End Sub
fwiw, I changed my approach on this. Instead of searching for styles, I go through each paragraph in the document and see if the style is "Principle" or "BusinessRule". If true, then I copy/paste the paragraph. So not only do I get the "or", but I also get them in order.
Related
I am not familiar with VBA at all.
I want to search for text I select (rather than a given list of words or typing that text in a box), and then change its format (preferably make it bold or change its color).
I tried to change a few macros that I found.
The VBA code for this can be rather simple. For example:
Sub MakeBold()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Font.Bold = True
.Text = Selection.Text
.Replacement.Text = "^&"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.Execute Replace:=wdReplaceAll
End With
End With
Application.ScreenUpdating = True
End Sub
For PC macro installation & usage instructions, see: http://www.gmayor.com/installing_macro.htm
For Mac macro installation & usage instructions, see: https://wordmvp.com/Mac/InstallMacro.html
This will do what you want. Copy/paste into your VB editor window.
Sub HighlightWords()
Dim Word As Range
Dim WordCollection(2) As String
Dim Words As Variant
'Define list.
'If you add or delete, change value above in Dim statement.
WordCollection(0) = "you"
WordCollection(1) = "or"
WordCollection(2) = "Word document"
'Set highlight color.
Options.DefaultHighlightColorIndex = wdYellow
'Clear existing formatting and settings in Find feature.
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
'Set highlight to replace setting.
Selection.Find.Replacement.Highlight = True
'Cycle through document and find words in collection.
'Highlight words when found.
For Each Word In ActiveDocument.Words
For Each Words In WordCollection
With Selection.Find
.Text = Words
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next
Next
End Sub
Before:
After:
I have a question about a problem i need do solve.
I have a word doc, on which i want to run a search and replace query.
But i dont want to change the actual text, i want to put the changed text
in the clipboard and leave the actual one unchanged.
Sub SearchAndReplace()
' marks all bold words,italic words, underlined
Selection.Find.ClearFormatting
Selection.Find.Font.Bold = True
Selection.Find.Font.Italic = True
Selection.Find.Font.Underline = wdUnderlineSingle
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = "[test]^&[/test]"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = True
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Cautious:
I guess there are better ways to achieve what you want to do as this is not proper coding. (Also as the clipboard only has a limit of 24 items), but for the sake of making your code works, here is my answer:
To copy the text in the clipboard instead of replacing it, you can just use the .copy method.
If you replace your line:
Selection.Find.Execute Replace:=wdReplaceAll
by
Dim iCount As Long
Selection.Find.Execute
Selection.Copy
Do While Selection.Find.Found = True And iCount < 1000
iCount = iCount + 1
Selection.Find.Execute
Selection.Copy
Loop
it should work.
The code is simply copying the item found after each search.
Selection.Find.Execute searches the next itteration of the search every time it appears in the code.
Once there are no search found anymore (or there are too many searches), the loop will stop.
I have a document in Word which contains hundreds of the Italicized words that have no space in between themselves and the previous word.
For example:
The quickbrown fox jumps over the lazydog.
The result I am looking for is:
The quick brown fox jumps over the lazy dog.
I've been trying to construct a macro using the Find and replace and .InsertBefore to solve this issue for me but with no success.
This is the code I have so far.
Sub FindItalics()
Selection.Find.ClearFormatting
Selection.Find.Font.Italic = True
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
InsertBefore
End Sub
Sub InsertBefore()
With Selection
.InsertBefore " "
End With
End Sub
I have found that this works and does what I require, however it only does it for the first italicized word in the document and will not continue throughout the rest of the document.
I think you can do this without VBA:
In Word's Find/Replace turn on search with wildcards, search for Format, Font..., Italic and search for the pattern (*>).
The * means find anything,
the > means find to the end of the word, and
the () parentheses will create a autonumbered group when the pattern is matched.
In the Replace box, don't change the format and Replace with text: <space>\1 to insert a space followed by group #1.
This worked for me:
Sub FindItalics()
Dim rng As Range
Set rng = Selection.Range
With rng.Find
.Text = ""
.Replacement.Text = ""
.ClearFormatting
.Wrap = wdFindStop
.Format = True
.Font.Italic = True
.MatchWholeWord = False
.Forward = True
While .Execute
'Note: 'rng' is now the range containing the matched content
rng.InsertBefore " "
rng.Collapse wdCollapseEnd
Wend
End With
End Sub
I need to delete all of new lines if is consecutive, i know macros in excel but not in word, how can i read the value of an entire line?
I read all the lines in the doc with this:
For i = 1 To 10
Selection.MoveDown Unit:=wdLine, Count:=1
Next i
Is there other way of read each line or how to know the total lines in a word to put this in the for?
Thanks
I need to delete all of new lines if is consecutive
Each blank line is actually a paragraph, so:
Sub RemoveBlankParas()
Dim para As Paragraph
For Each para In ActiveDocument.Paragraphs
If Len(para.Range.Text) = 1 Then
'only the paragraph mark, so..
para.Range.Delete
End If
Next para
End Sub
However, if there are only two consecutive blank paragraphs then using ReplaceAll is easier and quicker. Here's a recorded macro that can be tidied up:
Sub Macro2()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^p^p"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Word's Find/Replace feature uses a primitive form of regular expressions, so the following reduces two or more consecutive paragraph marks. NB MatchWildcards = True to use regex:
Sub Macro2()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "(^13)\1#"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Word regular expressions
I make a several page word document every week. I copy text from a PDF and paste it into a word document, I then format the text that I pasted.
This takes a long time and i would like to automate it.
I need a macro or some code to select specific text, then make that text bold. The specific text i need to bold is what i call a scrap code.
There are 60 different codes. For example "FIPS", or "LILL".
Something like this:
Sub A()
'
' a Macro
'
'
Dim A(3) As String
A(1) = "code1"
A(2) = "code2"
A(3) = "code3"
For i = 1 To 3
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Replacement.Font.Bold = True
.Execute FindText:=A(i), ReplaceWith:=A(i), Format:=True, _
Replace:=wdReplaceAll
End With
Next i
End Sub
HTH!
Edit
To switch dollar amounts to bold
Sub a()
'
' a Macro
'
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Bold = True
With Selection.Find
.Text = "$([0-9.,]{1,})"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
I would suggest recording a macro.
Then do all the modifications and formatting.
Finally, look at the code of the macro and see how it did it.
The one thing you need to figure out is how you logically want to locate the text you want to bold.
Is it a specific line? Is it at the beginning of a known word?
Once you have that answered, you can combine it with the code of the macro and automate the task.