I am trying to create multiple word documents all based on one template, currently I can open the template word doc and save it as the file name I want which gets pulled from a table in excel. What I want to do is replace the text "##Title##" in the template before I save it as a new document. This is the code I have which does not replace any text:
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open(reportTemplate)
objDoc.Content.Find.Text = "##Title##"
objDoc.Application.Selection.Find.Text = "##Title##"
objDoc.Application.Selection.Find.Execute
objDoc.Application.Selection.Find.Replacement.Text = clients(i)
objDoc.Application.Selection.Find.Execute
objWord.Visible = True
objDoc.SaveAs (fileName)
Any help would be great, thanks!
You don't need to do an execute when searching (only for replacing), and a common answer here would be :
With objDoc.Content.Find
.Text = "##Title##"
.Replacement.Text = clients(i)
.Forward = True
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceOne
End With
The microsoft official documentation also has good examples
Related
I am creating an automated document generation tool using data from an Excel workbook through VBA code.
The code below replaces text and inserts the images, however, they get pushed into the top of the document.
Is there any way to return the position of the found text, declare a range based on the position, and use that to insert the inline-shape (image) into the line after the tagName text?
I had this working previously through calling Word macros from Excel, however, this needs to be completely Excel based.
This program will be handling Word documents that have no VBA.
For Each sr2 In wDoc.StoryRanges
With sr2.Find
.Text = tagName
.Replacement.Text = tagValue
.Wrap = 1
.Execute Replace:=2
If .Found = True Then
sr2.InlineShapes.AddPicture fileName:=ThisWorkbook.Path & "\1. SOW Templates\ Client Summary import.jpg"
End If
End With
Next sr2
To easily loop through the results of the Find method, it would be easier if you are using Replace:=wdReplaceOne (wdReplaceOne=1) instead of Replace:=wdReplaceAll (wdReplaceAll=2). (Based on this this answer).
To insert the image, I would suggest you to select the range you want the image to be. Add it as a free floating image and then convert it to an inline shape.
Here's a way to do this:
Dim r As Object 'Word.Range
Dim bFound As Boolean
bFound = True
Set r = wDoc.Content
r.Find.ClearFormatting
Do While bFound
With r.Find
.Text = tagname
.Replacement.Text = tagValue
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
bFound = .Execute(Replace:=wdReplaceOne)
End With
If bFound Then
r.Select
Selection.Next(Unit:=wdParagraph, Count:=1).Select
Dim img As Object 'Word.Shape
Set img = wDoc.Shapes.AddPicture(Filename:=ThisWorkbook.Path & "\1. SOW Templates\ Client Summary import.jpg")
img.ConvertToInlineShape
End If
Loop
Would you please help me to select the whole paragraph beneath a given heading in a word file and import its content to an excel file through VBA?
The heading is always named 'Notes' in the word file and is the heading 4 when I use the Go to command to reach it.
I tried to use the content.find property with the word.application object but it copies the entire document.
I also tried to reach the requested title with the GoTo method with the following paraeters: what:=wdGoToHeading, which:=wdGoToAbsolute, Count:=4, but it is not accepted by the method and outputs an error message when compiled.
Sub ImportWordTables()
'Imports a table from Word document
Dim applWord As Object
Dim notes As String
Dim wdDoc As Object
Dim wdDocName As String
Dim wdFileName As Variant
...
Set applWord = CreateObject("Word.Application")
applWord.Visible = True
applWord.WindowState = 1
wdFileName = Application.GetOpenFilename("Word files (*.doc*),*.doc*", , _
"Browse for file containing table to be imported")
If wdFileName = False Then Exit Sub '(user cancelled import file browser)
Application.Goto (ActiveWorkbook.Sheets("Sheet1").Range("A1"))
Set wdDoc = applWord.Documents.Open(wdFileName)
I tried:
applWord.ActiveDocument.Range.Selection.Goto what:=wdGoToHeading, which:=wdGoToAbsolute, Count:=4
And:
With applWord.ActiveDocument.Content.Find
.ClearFormatting
.Text = "Notes"
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
With .Parent
.Select
.Copy
End With
applWord.ActiveDocument.Range.Selection.Copy
Thanks a lot for your help and have a nice day !
You're on the right track with Content.Find...
When you use Find, remember to also use .Execute, otherwise, nothing will happen. It's like clicking the OK button in a dialog box, after setting the properties.
Generally, it's better to use a dedicated Range object with Find that can be manipulated. When Find is run, the range or selection on which it is executed will change to the "found" content. So Selection.Find would have worked for you (as long as you execute). But ActiveDocument.Content cannot because it can't change. That's why a dedicated Range object is needed.
Extending the found content: Word has a number of Move methods for ranges and selections. For this, I'd use MoveEnd (for details see the language reference).
The following code snippet, based on code in the question, illustrates these points.
Dim rngFind As Object
Set wdDoc = applWord.Documents.Open(wdFileName)
Set rngFind = wdDoc.content
With rngFind.Find
.ClearFormatting
.Text = "Notes"
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Format = True
If .Execute Then
rngFind.MoveEnd wdParagraph, 2
rngFind.Copy
End If
End With
Thanks again for your help.
I achieved to get something into the clipboard with the following:
Dim applWord As Object
Dim rngFind As Word.Range
Set rngFind = ActiveDocument.Content
With rngFind.Find
.ClearFormatting
.Text = "Notes"
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
rngFind.MoveEnd wdParagraph, 2
rngFind.Select
rngFind.Copy
There are many code lines next to this to change the layout, add some formulas, etc., but I do not put them for clarity purpose.
So, it works !
Next difficulty is with
rngFind.MoveEnd wdParagraph, 2
In fact, the content of the 'Notes' heading in my word file is a numbering list, so it is like:
Notes
1) first point
2) ...
3) ...
4) ...
With an undefined number of elements.
Is there a command I can use to be sure to catch the whole paragraph?
Yesterday, I tried to find a VBA command which would allow to collapse the heading, before copying it. The equivalent of right clicking next to it, 'Expand/collapse', then 'collapse heading'. I did not find anything like this, and I am not sure it is the best way to achieve what I would like.
So, if you still have bit of time to advise me, you would be warmly welcome :-)
Thanks and have a nice day !
I have some code in Excel which updates a Word document and then saves it depending on the information in the cells. The only issue is that occasionally there's an error which pops up
Office is still updating linked or embedded objects for this workbook.
when the code is all completed successfully.
There are no other linked or embedded objects in the workbook.
This error was being shown when running the script manually before I added the button, so it doesn't make sense for it to be related to the button itself.
I am working on this independently meaning no others could be editing it at the same time. I click the button/run it, let it run, it freezes after closing Word (the last line of code) and then about 10secs later that error comes up.
I've attempted to add UpdateLinks:=0 and UpdateLinks:=false to the code but everywhere I put it it seems to not like having it there. I am not sure of how else to fix this but it cannot be an Excel/Word setting as a number of users will be utilising this.
Here's the current code:
Sub Button3_Click()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim msWord As Object
Dim msWordDoc As Object
Set msWord = CreateObject("Word.Application")
msWord.Visible = True
Set msWordDoc = msWord.Documents.Open("/Users/Aafrika/Desktop/Test.docx")
With msWordDoc
With .Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "<date>"
.Replacement.Text = Format(ws.Range("C1").Value2, "dd/mm/yyyy")
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
.Text = "<amount>"
.Replacement.Text = Format(ws.Range("C2").Value2, "currency")
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
End With
.SaveAs Filename:="/Users/Aafrika/Desktop/" & ws.Range("C3"), Password:="Password", FileFormat:=12 'wdFormatXMLDocument
DoEvents
.Close (False)
End With
msWord.Quit
End Sub
Hoping you can all shed some light on how to handle this!
The problem comes from Excel not being able to correctly release the Word objects. This is something that always should be done conscientiously when running another program through VBA ("automation" is one technical term used for this).
When you create objects from another program, in the background VBA creates "pointers" (links) to these objects. If they aren't expliclty released - in the reverse order they were created - this can "hang" VBA. There are various ways this can manifest itself - this is the first time I've seen this particular error and a quick google search doesn't turn up many examples. Possibly, this is an error that's new in Office 365/2016/2019...
The button (embedded object) has finished (reached End Sub) but hasn't released the objects it was working with, so Excel is waiting for that to happen.
The following code, modified from that in the question, shows how to release the objects created in the code (near the end). It involves Set [object] = Nothing for both the Word.Document and Word.Application objects, in the reverse order they were created at the beginning of the code.
Sub Button3_Click()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim msWord As Object
Dim msWordDoc As Object
Set msWord = CreateObject("Word.Application")
msWord.Visible = True
Set msWordDoc = msWord.Documents.Open("/Users/Aafrika/Desktop/Test.docx")
With msWordDoc
'Code here to work with the document
'Removed to better see the problem solution
.SaveAs Filename:="/Users/Aafrika/Desktop/" & ws.Range("C3"), Password:="Password", FileFormat:=12 'wdFormatXMLDocument
DoEvents
.Close (False)
End With
'''Clean up the non-Excel objects
Set msWordDoc = Nothing
msWord.Quit
Set msWord = Nothing
End Sub
I am using VBA codeI picked up online to essentially input a couple of sections and have Excel then edit a Word template, replacing <oaccount> for the inputted account number and <date> for the date of something, etc.
The issue I am facing is that when using it, the core value of the cell is being inputted and not what you see... For example, I have everything working except the date and the $ amount because when it replaces <date> and <amount> they show up as "240419" and "3450" when inputting 24/04/2019 and $3,460.00 respectively.
I want to find out how to get Excel to replace the key words with the actual displayed value of Excel.
Below is what I am using to do this:
Option Explicit
Public Sub WordFindAndReplace()
Dim ws As Worksheet, msWord As Object
Set ws = ActiveSheet
Set msWord = CreateObject("Word.Application")
With msWord
.Visible = True
.Documents.Open "F:\Test folder\TestFolder\Test.docx"
.Activate
With .ActiveDocument.Content.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "CName"
.Replacement.Text = ws.Range("C1525").Value2
.Forward = True
.Wrap = 1 'wdFindContinue (WdFindWrap Enumeration)
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=2 'wdReplaceAll (WdReplace Enumeration)
End With
.Quit SaveChanges:=True
End With
End Sub
Have you tried using the Format function on the replacement line? There's a page with a description of it here. You can also try converting it to a string in that same line using the CStr() function.
It would look something like this if you use format:
.Replacement.Text = Format(ws.Range("C1525").Value2,"dd/mm/yyyy")
If you use the string conversion it would look like this:
.Replacement.Text = CStr(ws.Range("C1525").Value2)
I would like to highlight specific words given in a specific column of an excel sheet in a word document.
I have a working solution (see below) that reads the words from a word file but I can not get it running to do the same thing using a specific column from an excel file. Essentially I want to do what the following python code does (but for VBA):
import pandas as pd
all = pd.read_excel("list.xlsx")
docRef = all(all["MY COLUMN NAME"])
... and the docRef should be used in the code below. I just cant get it running ...
Sub highlightWords()
Dim sCheckDoc As String
Dim docRef As Document
Dim docCurrent As Document
Dim wrdRef As Object
sCheckDoc = "list.docx"
Set docCurrent = Selection.Document
Set docRef = Documents.Open(sCheckDoc)
docCurrent.Activate
Options.DefaultHighlightColorIndex = wdRed
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Highlight = True
.Replacement.Text = "^&"
.Forward = True
.Format = True
.MatchWholeWord = True
.MatchCase = False
.MatchWildcards = False
End With
For Each wrdRef In docRef.Words
If Asc(Left(wrdRef, 1)) > 32 Then
With Selection.Find
.Wrap = wdFindContinue
.Text = wrdRef
.Execute Replace:=wdReplaceAll
End With
End If
Next wrdRef
docRef.Close
docCurrent.Activate
End Sub
Code modified from here.
In order to control Excel from within Word you should set a reference to the Excel library in the Word VBA editor : Tools, References, scroll down to Microsoft Excel and tick it.
Then you need to open Excel, and load the workbook
Dim XL as new Excel.Application
Dim wb as Excel.Workbook
Set wb = xl.Workbooks.open("path and name of file list.xlsx")
For Each wordref in wb.Sheets(1).Range("a1:A" & wb.Sheets(1).usedrange.rows.count)