Find and replace text with an image in Word using VBA macro - vba

I am having some trouble with this macro I am trying to create.
What I want to achieve is having a Source Word Document that contains a table with 2 columns, column 1 will hold the text I want to find within another document. In the 2nd column will either be an image or a file path to an image.
The macro script should open the source document, then run through the current document and find all the matching text and then replace that with the image.
This is what my script looks like currently:
Sub FindReplaceWithValuesFromTable()
' Open the document containing the replacement values
Dim tblDoc As Document
Set tblDoc = Documents.Open("C:\path\to\replacement_values.docx")
' Loop through each row in the table and perform the find and replace operation
Dim tbl As Table
Dim findText As String
Dim replaceText As String
Set tbl = tblDoc.Tables(1)
For i = 1 To tbl.Rows.Count
findText = tbl.Cell(i, 1).Range.Text
replaceText = tbl.Cell(i, 2).Range.Text
' Trim the find and replace text to remove any unwanted characters
findText = Trim(findText)
replaceText = Trim(replaceText)
' Perform the find and replace operation
ActiveDocument.Content.Find.Execute findText, ReplaceWith:=replaceText, Replace:=wdReplaceAll
Next i
' Close the document containing the replacement values
tblDoc.Close
End Sub
The script runs without an error but does absolutely nothing else.
I have tried removing all the formatting on both source and destination documents
I have tried using an image and then re-doing the script to allow for the image field
I have tried just replacing text with text.

Related

How to reasign indentation after converting all paragraphs to a table in Word document with VBA?

I'm regularly working with large Word documents. I have to convert all paragraphs to a table.
Source document structure sample:
After conversion (Insert -> Table -> Convert text to table) Word loses information about indents for random paragraphs. Target document:
As you can see, indents for paragraphs "c" and "d" disappeared. Don't know why but it happens quite often.
It should be exactly the same as in the source documents:
Finding and correcting the errors for very large documents takes hours, so I thought that I can repair broken indents in the target document by taking indent values from the source paragraphs.
This is my first attempt using VBA, I started like this:
Dim sourceDocument, targetDocument As Document
Dim myRange As Range
Set sourceDocument = ActiveDocument
Set targetDocument = Documents.Add(ActiveDocument.FullName)
Set myRange = targetDocument.Range(Start:=targetDocument.paragraphs(1).Range.Start, End:=targetDocument.paragraphs(targetDocument.paragraphs.Count).Range.End)
myRange.converttotable Separator:=wdSeparateByParagraphs
Dim i As Integer
For i = 1 To targetDocument.Tables(1).Range.Rows.Count
targetDocument.Tables(1).Range.Rows(i).Range.Cells(1).Range.paragraphs(1).LeftIndent = sourceDocument.paragraphs(i).LeftIndent
targetDocument.Tables(1).Range.Rows(i).Range.Cells(1).Range.paragraphs(1).FirstLineIndent = sourceDocument.paragraphs(i).FirstLineIndent
Next i
The script works as expected for simple paragraphs since the number of paragraphs matches the count of rows in the target table. But in the case of tables existing in source document it gets messy. In tables, the number of paragraphs is doubled.
Source tables are nested in one target cell which is fine, no problems with them, and they do not have to be corrected.
So my question is how to match source paragraphs with target paragraphs in tables (omitting source tables and target nested tables)?
Or maybe there is another way of converting paragraphs to a table with correct indentation?
There would be a number of ways to approach this. After some consideration, I decided a fairly straight-forward one would be to get an array of all the paragraphs not in a table from the source document.
When looping the rows in the target document the number of paragraphs will be greater than one only in rows that contain a nested table. In this case, the Range is set to the end (last paragraph).
Then the indent is applied from the corresponding paragraph in the array using the loop counter (plus 1, since arrays are 0-based).
Sub RestoreParaIndents()
Dim sourceDocument As Document, targetDocument As Document
Dim myRange As Range
Set sourceDocument = ActiveDocument
Set targetDocument = Documents.Add(ActiveDocument.FullName)
Set myRange = targetDocument.content
'Get an array of all paragraphs not in a table in the source document
'This will provide the indent information in the loop for the target document
Dim aParas() As Paragraph, para As Paragraph
Dim counterPara As Long
counterPara = 0
For Each para In sourceDocument.Paragraphs
If Not para.Range.Information(wdWithInTable) Then
ReDim Preserve aParas(counterPara)
Set aParas(counterPara) = para
counterPara = counterPara + 1
End If
Next
myRange.ConvertToTable Separator:=wdSeparateByParagraphs
Dim i As Long
Dim rw As Row, rng As Range
For i = 1 To targetDocument.Tables(1).Range.Rows.Count
Set rw = targetDocument.Tables(1).Range.Rows(i)
Set rng = rw.Range.Cells(1).Range
'If the cell contains multiple paragraphs then in contains
'a nested table. Skip the table and go to the end (last paragraph)
If rng.Paragraphs.Count > 1 Then
Set rng = rng.Paragraphs.Last.Range
End If
rng.Paragraphs(1).LeftIndent = aParas(i - 1).LeftIndent
rng.Paragraphs(1).FirstLineIndent = aParas(i - 1).FirstLineIndent
Next i
End Sub

VBA MS Word - Insert all mail merge fields into Word doc at once

Currently MS Word only allows for the insertion of 1 mail merge field at a time. I am looking for a VBA code that would allow me to insert all merge fields into a Word doc at once and/or a code that would input a mail merge field where the name of the same mail merge text appears in the doc.
For the second possibility I have found the following code that allows the user to convert text that matches a mail merge name into a mail merge field one at a time ( http://apsona.com/blog/how-to-quickly-create-merge-fields-in-word/ ). I am dealing with a data source that contains thousands of mail merge fields so ideally I would want to do this for all of them at once or create a loop or something similar.
Sub MakeMergeField()
Selection.Copy
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"MERGEFIELD """ + Selection.Text + """, PreserveFormatting:=True"
End Sub
There's no functionality in Word to insert all merge fields at once, so you need to insert them individually, in a loop.
The following does that, separating each merge field by a space.
(Note: Normally, when you insert something in Word, the target Range encompasses what was inserted - not so with merge fields. That's why Range.Start is moved to the end of the document after each insertion, before adding a space to it. Then the Range needs to be "collapsed" beyond that space before doing the next insertion.)
Sub InsertAllMergeFields()
Dim doc As word.Document
Dim rng As word.Range
Dim mm As word.MailMergeDataField
Set doc = ActiveDocument
Set rng = doc.content
If doc.MailMerge.MainDocumentType <> wdNotAMergeDocument Then
For Each mm In doc.MailMerge.DataSource.DataFields
doc.MailMerge.Fields.Add rng, mm.NAME
rng.Start = doc.content.End
rng.InsertAfter " "
rng.Collapse wdCollapseEnd
Next
End If
End Sub

Save Word document as a filename generated from tabled info contained within the document

I am looking to enable Word to save with a file name using data contained within the document.
At the top of the document (an airline release letter), there is a table containing 2 columns with 3 rows containing alpha in one column and alpha-numeric data in column 2.
Column 1,
Cell 1: AETC; Cell 2: MAWB; Cell 3: HAWB
Column 2,
Cell 1: 80123; Cell 2, 0161234567; Cell 3: 00112345678
Basically, the first column will be the static labels for the variable data to be entered into column 2.
From all this, I want to generate a save-as file name: AETC80123_MAWB0161234567_HAWB00112345678_ReleaseLetter.doc
I've barely scratched the surface of VBA as I am more an operations supervisor than a techie so I'm not certain if this is even possible.
Any help/direction/copy-paste coding (if it's super easy and of little trouble) would be awesome!
Thanks!
I am not going to work it all out in detail for, nor is this tested at all (just written out of my head), but this should give a hint how you read cell content in a Word document:
' Set tbl to first table in document
Dim tbl As Table
Set tbl = ActiveDocument.Tables(0)
Dim r As Integer
Dim c As Integer
Dim val As String
Dim filename As String
filename = ""
For r = 1 To tbl.Rows.Count
For c = 1 To tbl.Columns.Count
' Get text in cell
val = tbl.Cell(r, c).Range.Text
' and append to string or whatever
filename = filename & val & "_"
Next c
Next r
Finally, save your document using
ActiveDocument.SaveAs FileName:=filename
Check this microsoft site for more information about SaveAs parameters.

Changing color on all but one table in Word with VBA

I have a macro that I'm using to remove all of the color in all of the tables in certain Word Documents. The colors being removed are there initially to indicate where someone should type.
Trust me, I'd rather use form fields or ActiveX text boxes, but this is not a situation where they will work as Word is being opened through a 3rd party application that invalidates these with a mail merge. Anyway, I want to skip over the first table. I have the code below set up to do it, then change the first cell of the first table back to a particular color.
Sub decolordocument()
'
' decolordocument Macro
'
'
Dim tbl As Table
For Each tbl In ActiveDocument.Tables
tbl.Shading.BackgroundPatternColor = wdColorWhite
Next
ActiveDocument.Tables(1).Cell(1, 1).Shading.BackgroundPatternColor = wdColorLightTurquoise
End Sub
This works fine for removing the color, but the color of that first cell of the first table isn't the same in all of them. I just want to skip the first table during the for each loop. I've tried an if statement (If tbl = ActiveDocument.Tables(1) Then...) but evidently this is not an allowed comparison as it doesn't recognize the Then statement. I've also tried doing this with a range, but couldn't quite get it right. Any thoughts would be appreciated.
Sub decolordocument()
'
' decolordocument Macro
'
'
Dim first as Boolean
Dim tbl As Table
first = true
For Each tbl In ActiveDocument.Tables
If first Then
first = false
Else
tbl.Shading.BackgroundPatternColor = wdColorWhite
End If
Next
'ActiveDocument.Tables(1).Cell(1, 1).Shading.BackgroundPatternColor = wdColorLightTurquoise
End Sub
if activedocument.Tables.Count >1 then
for x = 2 to activedocument.Tables.Count
activedocument.Tables(x).Shading.BackgroundPatternColor = wdColorWhite
next x
end if

Word 2010 template table generation

I'm trying to use Word 2010 to create a template for a programming project test plan. I've created a mockup template showing what I want to do.
What I'd like to be able to do is be able to click on something on the Word ribbon, and have the template generate the next test table and sequence the caption. Once the table is generated, I would fill in the table fields for the test.
Could someone tell me what to look up in the Word help or elsewhere so I can create this template?
I personally would create a macro for this or you can embed it in your template with code to add menu items and add something like the following. (It's very rough but you can use it to generate a table with your layout and numeric ascending numbers), it is not as dynamic as knowing where the previous test left off but should be a start point.)
Dim iCount As Integer
iCount = CInt(InputBox("How many tables?", "Table Count", 1))
For icurtable = 1 To iCount
Dim oTableRange As Paragraph
Dim oTable As Table
Dim oCaption As Paragraph
Set oCaption = ActiveDocument.Paragraphs.Add
Call oCaption.Range.InsertBefore(CStr(icurtable))
Set oTableRange = ActiveDocument.Paragraphs.Add
Set oTable = oTableRange.Range.Tables.Add(oTableRange.Range, 4, 1, True, True)
oTable.Rows.First.Cells(1).Range.InsertBefore ("Setup:")
oTable.Rows(2).Cells(1).Range.InsertBefore ("Test:")
oTable.Rows(3).Cells(1).Range.InsertBefore ("Expected Response:")
oTable.Rows(4).Cells(1).Range.InsertBefore ("Restore")
Call oTableRange.Range.InsertAfter(vbCrLf)
Next
In case someone else comes across this question, I'll provide my solution. I decided to create a table inside of a table so the test case number will be on the left, where people expect to see it.
Using Sacha's answer as a model, and making liberal use of the macro recorder, I came up with this VBA macro that does most of what I want.
Sub InsertTestTable()
'
' InsertTestTable Macro
' This macro inserts a test table into the document.
'
Dim oTable As Table
Dim iTable As Table
Set oTable = ActiveDocument.Tables.Add(Selection.Range, 1, 2, _
wdWord9TableBehavior, wdAutoFitContent)
Selection.TypeText ("1.")
Selection.MoveRight
Set iTable = ActiveDocument.Tables.Add(Selection.Range, 4, 2, _
wdWord9TableBehavior, wdAutoFitContent)
iTable.Rows(1).Cells(1).Range.InsertBefore ("Setup:")
iTable.Rows(2).Cells(1).Range.InsertBefore ("Test:")
iTable.Rows(3).Cells(1).Range.InsertBefore ("Expected Response:")
iTable.Rows(4).Cells(1).Range.InsertBefore ("Restore:")
iTable.Rows(1).Cells(2).Range.Select
End Sub
Now, all I need to do is format the tables the way I want, and figure out how to have the number ascend through the set of tables in the document.