I am trying to convert all the text "0.236" in the find object but not all the instances it finds are changing.
Some help to fix this macro would be great.
Thank you.
Sub ConvertTO6MM()
Dim wrdFind As Find
Dim wrdRng As Range
Dim wrdDoc As Document
Set wrdDoc = Application.ActiveDocument
Set wrdRng = wrdDoc.Content
Set wrdFind = wrdRng.Find
With wrdFind
.Forward = True
.MatchPhrase = True
.Wrap = wdFindContinue
.Execute FindText:="0.236"
End With
Do While wrdFind.Execute = True
wrdRng.Text = Round(0.236 * 25.4, 0) & " MM"
Loop
End Sub
You need to use the Replacement object which represents the replace criteria for a find and replace operation. The properties and methods of the Replacement object correspond to the options in the Find and Replace dialog box (Edit menu).
The Replacement object is available from the Find object. The following example replaces all occurrences of the string "0.236" with "6 MM". The selection changes when the find criteria is found because the Find object is accessed from the Selection object.
With Selection.Find
'.ClearFormatting
.Text = "0.236"
'.Replacement.ClearFormatting
.Replacement.Text = "6 MM"
.Execute Replace:=wdReplaceAll, Forward:=True, Wrap:=wdFindContinue
End With
Related
I am attempting to write a macro that will automatically verify that the forms present in two documents are the same.
To do this I need to search through one document and create an array that is a list of all of the forms in that document. Each form is designated by a unique code like AB001 or E363. I am currently searching for these terms and highlighting them using this code I blatantly stole off the internet.
Dim word As Range
Dim wordcollection(9) As String
Dim words As Variant
'Define list.
'If you add or delete, change value above in Dim statement.
wordcollection(0) = "PJ"
wordcollection(1) = "E1233"
wordcollection(2) = "E048"
wordcollection(3) = "E144"
wordcollection(4) = "E849"
wordcollection(5) = "E977"
wordcollection(6) = "IL0021"
wordcollection(7) = "MISC001"
wordcollection(8) = "CG0001"
wordcollection(9) = "CG2107"
'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
I need to figure out how to copy the values that are present in the document into a new array
Then I need to search another document for the same values and copy the values that are present in that document into another new array
Finally I need to compare both of the new arrays and print a list of the values that are present in new array A but not new array b and vice versa.
Any help would be appreciated. The extent of my VBA experience is writing macros to automatically copy data in formfields to new formfields so even a basic understanding of how to do this would be appreciated.
Thanks!
Doing a ReplaceAll in your existing code doesn't give you any runtime feedback. You have to isolate the Found variable and then you can determine what to do. My recommendation is to separate the single macro into two parts with the second macro providing the feedback that the code was found so that you can then take action.
To provide you with an example of what I am attempting to describe, below is an example and the output are separate text files that show what codes exist in each document. Hopefully you can adapt this to meet your requirements.
Sub FindCodes()
Dim doc As word.Document
Dim i As Long, wrkFolder As String, fName As String
Dim oFile As String, FileNum As Integer
Dim Codes(0 To 2) As String
Codes(0) = "PJ"
Codes(1) = "E1233"
Codes(2) = "E048"
On Error GoTo errHandler
wrkFolder = "c:\users\<your id>\documents\test\"
fName = Dir(wrkFolder & "*.docx", vbNormal)
Do While fName <> vbNullString
Set doc = Documents.Open(wrkFolder & fName)
oFile = Left(doc.FullName, InStrRev(doc.FullName, ".") - 1) & "_Codes.txt"
On Error Resume Next
Kill oFile
On Error GoTo errHandler
FileNum = FreeFile()
Open oFile For Append As #FileNum
Print #FileNum, doc.Name
For i = 0 To UBound(Codes)
If Not CheckDocument(doc, Codes(i)) = vbNullString Then
'the code was found in the document
'print it in a text file
Print #FileNum, Codes(i)
End If
Next
Close #FileNum
doc.Save
doc.Close
fName = Dir()
Loop
errHandler:
If Err.Number <> 0 Then
MsgBox Err.Description, vbExclamation, "Find Codes"
Err.Clear
End If
End Sub
Private Function CheckDocument(ByRef doc As word.Document, StrCode As String) As String
Dim rng As word.Range
For Each rng In doc.StoryRanges
'will search headers, footers and the document body
With rng.Find
.ClearFormatting
.Format = True
.Forward = True
.MatchCase = True
.MatchWholeWord = True
.Text = StrCode
.Wrap = wdFindStop
.Execute
If .Found Then
'this will highlight the first code found and then exit
'does it really need to highlight all places the code
'was found? If so, comment out this IF statement and
'use the loop method instead
rng.HighlightColorIndex = wdYellow
CheckDocument = .Text
Exit Function
End If
' Do While .Found
' rng.HighlightColorIndex = wdYellow
' CheckDocument = .Text
' Loop
End With
Next
End Function
Here is a sample of text from my word document :
https://www.noelshack.com/2018-31-2-1533054408-word.png
I am new to VBA and I am trying to write a macro that looks for the specific text """"Eligible Currency"" means the Base Currency and each other currency specified here:" and replace the two following lines (filled with some dots, not necessarily in the same paragraph) with a list of text (for instance : Euro, Dollar).
So far I have been able to loop through the document, find the specific text and edit it, using the code :
Sub FindAndFormat()
Dim objWord As Object
Dim wdDoc As Object
Dim ParagraphRange As Object
Dim intParaCount
On Error Resume Next
Set objWord = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set objWord = CreateObject("Word.Application")
End If
On Error GoTo 0
Set wdDoc = objWord.Documents.Open("D:\Modele.docx")
objWord.Visible = True
Dim Paragraph As Word.Paragraph
For Each Paragraph In wdDoc.Paragraphs
Set ParagraphRange = Paragraph.Range
ParagraphRange.Find.Text = """Eligible Currency"" means the Base Currency and each other currency specified here:"
ParagraphRange.Find.Execute
If ParagraphRange.Find.Found Then
ParagraphRange.Text = """Eligible Currency"" means the Base Currency and each other currency specified here: Euro, Dollar"
End If
Next
End Sub
Note that the style of the whole line is getting bold and italic.
https://www.noelshack.com/2018-31-2-1533055581-word2.png
What I really would like to achieve is replacing the dotty lines :
https://www.noelshack.com/2018-31-2-1533055647-word3.png
Now there may be several other dotty lines in my document, and they may not always contain exactly the same amount of dots.
Thank you for reading.
Try something along the lines of:
Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = """Eligible Currency""[!:]#:[ ….^13^l^t]{2,}"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
.End = .End - 1
.Start = .Start + InStr(.Text, ":")
.Text = Chr(11) & vbTab
.Collapse wdCollapseEnd
.Text = "Euro, Dollar"
.Font.Bold = True
.Font.Italic = True
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Application.ScreenUpdating = True
End Sub
I am looking for a way to create a new document containing all the text with a specific format from my document.
See below for what I wrote so far, but I'm stuck here:
how do I stop my loop when end of document is reached? or how do I add intelligence to my code to avoid a static loop, and rather do a "scan all my document"?
Option Explicit
Sub Macro1()
Dim objWord As Application
Dim objDoc As Document
Dim objSelection As Selection
Dim mArray() As String
Dim i As Long
Dim doc As Word.Document
For i = 1 To 100
ReDim Preserve mArray(i)
With Selection.Find
.ClearFormatting
.Font.Color = wdColorBlue
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.Execute
End With
mArray(i) = Selection.Text
Next
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add
objWord.Visible = True
Set objSelection = objWord.Selection
For i = 1 To 100
objSelection.TypeText (mArray(i))
Next
End Sub
Thanks to Cindy's nice tip (I could also have found relevant information in Loop through Word document, starting from beginning of file at start of each loop), and in case this could help someone some day:
define the format you are looking for thanks to Word's Macro Recorder
position yourself at the beginning of your document
Use a while loop checking wdFindStop -- It also demonstrate how to use Array of String in VBA--:
...
Sub Macro2()
Dim mArray() As String
Dim i As Long, n As Long
Dim doc As Word.Document
Dim isFound As Boolean
isFound = True
i = 1
'For i = 1 To 40
Do While (isFound)
ReDim Preserve mArray(i)
With Selection.Find
.ClearFormatting
.Font.Color = wdColorBlue
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
isFound = .Execute
End With
mArray(i) = Selection.Text
i = i + 1
Loop
'Next
n = i - 2
MsgBox n & " occurrences found."
'
' create a new document with the phrases found
Dim objWord As Application
Dim objDoc As Document
Dim objSelection As Selection
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add
objWord.Visible = True
Set objSelection = objWord.Selection
For i = 1 To n 'mArray's Size
objSelection.TypeText (mArray(i))
objSelection.TypeParagraph
Next
End Sub
NB: I could also have greatly benefited from https://msdn.microsoft.com/en-us/library/office/aa211953%28v=office.11%29.aspx that explains how to find without changing the selection:
With ActiveDocument.Content.Find
.Text = "blue"
.Forward = True
.Execute
If .Found = True Then .Parent.Bold = True
End With
And from here: Find text only of style "Heading 1" (Range.Find to match style)
I happen to have problems trying to manipulate the below code to my liking.
First off, the code below deletes everything in between the start and end conditions I have stipulated in my program.
I would like to change this, to delete everything besides those stipulated between the start and end words.
Sub SomeSub()
Dim StartWord As String, EndWord As String
Dim Find1stRange As Range, FindEndRange As Range
Dim DelRange As Range, DelStartRange As Range, DelEndRange As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Setting up the Ranges
Set Find1stRange = ActiveDocument.Range
Set FindEndRange = ActiveDocument.Range
Set DelRange = ActiveDocument.Range
'Set your Start and End Find words here to cleanup the script
StartWord = "From: Research.TA#traditionanalytics.com|Tradition Analytics Commentary| | |"
EndWord = "This message has been scanned for malware by Websense. www.websense.com"
'Starting the Find First Word
With Find1stRange.Find
.Text = StartWord
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
'Execute the Find
Do While .Execute
'If Found then do extra script
If .Found = True Then
'Setting the Found range to the DelStartRange
Set DelStartRange = Find1stRange
'Having these Selections during testing is benificial to test your script
DelStartRange.Select
'Setting the FindEndRange up for the remainder of the document form the end of the StartWord
FindEndRange.Start = DelStartRange.End
FindEndRange.End = ActiveDocument.Content.End
'Having these Selections during testing is benificial to test your script
FindEndRange.Select
'Setting the Find to look for the End Word
With FindEndRange.Find
.Text = EndWord
.Execute
'If Found then do extra script
If .Found = True Then
'Setting the Found range to the DelEndRange
Set DelEndRange = FindEndRange
'Having these Selections during testing is benificial to test your script
DelEndRange.Select
End If
End With
'Selecting the delete range
DelRange.Start = DelStartRange.Start
DelRange.End = DelEndRange.End
'Having these Selections during testing is benificial to test your script
DelRange.Select
'Remove comment to actually delete
DelRange.Delete
End If 'Ending the If Find1stRange .Found = True
Loop 'Ending the Do While .Execute Loop
End With 'Ending the Find1stRange.Find With Statement
End Sub
Hah! That's a new twist There's certainly more than one way to go about it; my inclination would be to work with (at least) three Ranges. Something like this:
Sub FindAndDeleteEverythingElse()
Dim strFind1 As String, strFind2 As String
Dim rngDoc As word.Range, rngFind1 As word.Range
Dim rngFind2 As word.Range
Dim bFound As Boolean
strFind1 = "You"
strFind2 = "directly."
Set rngDoc = ActiveDocument.content
Set rngFind1 = rngDoc.Duplicate
Set rngFind2 = rngDoc.Duplicate
With rngFind1.Find
.Text = strFind1
bFound = .Execute
End With
If bFound Then
With rngFind2.Find
.Text = strFind2
bFound = .Execute
End With
If bFound Then
rngDoc.End = rngFind1.Start
rngDoc.Delete
rngDoc.Start = rngFind2.End
rngDoc.End = ActiveDocument.content.End
rngDoc.Delete
End If
End If
End Sub
The "main" Range is that of the entire document: ActiveDocument.Content. The Range object is a bit different than other objects, if you set one Range to another it becomes that Range, not a copy. So you need the Duplicate method to make a copy of a Range. This lets you use Find independently for the various Ranges.
If the first Find is successful, the second one is executed. If that is also successful then the Document Range's end-point is set to the starting point of the successful Find and the content of the Range deleted. The Document Range is then re-defined to start at the end-point of the second found Range and end at the end of the Document, and deleted.
You will probably have to set more Range.Find properties than I did in this code snippet - I used the absolute minimum to make working with the Ranges clearer.
There maybe another way but till then you can do this.
try to add dummy character after and before your string like this
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchWildcards = False
.Text = "From: Research.TA#traditionanalytics.com|Tradition Analytics Commentary| | |"
.Replacement.Text = "From: Research.TA#traditionanalytics.com|Tradition Analytics Commentary| | |######"
.Execute Replace:=wdReplaceAll
.Text = "This message has been scanned for malware by Websense. www.websense.com"
.Replacement.Text = "######This message has been scanned for malware by Websense. www.websense.com"
.Execute Replace:=wdReplaceAll
End With
End With
End Sub
Then try to set range between ###### and ######
this is best answer to set range select a range of text from one Word document and copy into another Word document
Please note that in my word 2007 it is not possible to find within hyperlinks. Try to remove all hyperlink or within range before doing replacement.
another best answer for that: How do you remove hyperlinks from a Microsoft Word document?
I have 2 headers or markers that are a part of my RTF document. In my example I am showing a sentence when in reality it will be multiple sentences or paragraphs. I have used brackets instead of less than and greater than signs as they disappear in my question. All I want to do is replace the text between the 2 markers with the following sentence, "text goes here", without quotation marks.
[EmbeddedReport]Lots of text, thousands of character, multiple paragraphs[/EmbeddedReport]
I want replace all the text between the 2 markers replaced with "text goes here".
It would end up looking like this...
"[EmbeddedReport]text goes here[/EmbeddedReport]"
I've literally spent 2 days trying to solve this. Any help would be appreciated.
This is the last thing I tried...
Sub RemoveReport()
Dim c As Range
Dim StartWord As String, EndWord As String
Selection.HomeKey Unit:=wdStory
StartWord = "<ImageTable>"
EndWord = "</ImageTable>"
Set c = ActiveDocument.Content
c.Find.ClearFormatting
c.Find.Replacement.ClearFormatting
With c.Find
.Text = StartWord & "*" & EndWord
' MsgBox (.Text)
.Replacement.Text = "<ImageTable>text goes here</ImageTable>"
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
c.Find.Execute
While c.Find.Found
Debug.Print c.Text
'~~> I am assuming that the start word and the end word will only
'~~> be in the start and end respectively and not in the middle
Debug.Print Replace(Replace(c.Text, StartWord, ""), EndWord, "")
c.Find.Execute
Wend
End Sub
Word VBA is not my area of expertise, but it seems similar to a question I answered a few days ago.
Turns out the wildcard match was not doing what I hoped it would do, or at least it was not reliable. Also, I ran in to some trouble using angle brackets, so this uses square brackets. I suspect that word treats the angle brackets as markup/syntax, and thus does not interpret them as text in the Find object. There is probably a way around this, but Word VBA is not my specialty. There is also probably a more elegant solution, but again, Word VBA is not my specialty :)
Try something like this:
Option Explicit
Sub Test()
Dim doc As Document
Dim txtRange As Range
Dim startTag As String
Dim endTag As String
Dim s As Long
Dim e As Long
startTag = "[EmbeddedReport]"
endTag = "[/EmbeddedReport]"
Set doc = ActiveDocument
Set txtRange = doc.Content
'Find the opening tag
With txtRange.Find
.Text = startTag
.Forward = True
.Execute
If .Found Then
s = txtRange.Start
Else
GoTo EarlyExit
End If
End With
'Find the closing tag
Set txtRange = doc.Range(txtRange.End, doc.Content.End)
With txtRange.Find
.Text = endTag
.Forward = True
.Execute
If .Found Then
e = txtRange.End
Else
GoTo EarlyExit
End If
End With
Set txtRange = doc.Range(s, e)
txtRange.Text = startTag & "text goes here" & endTag
Exit Sub
EarlyExit:
MsgBox "Header not found in this document!", vbInformation
End Sub
It takes some time to figure it out at first, but learning to navigate the object model reference documentation for VBA will make these tasks a lot easier to figure out in the future.