How to replace Fields in Word document with their content using VBA? - vba

Some sites use textarea to publish code in articles. If someone copy/paste the article in Word, it shows empty textarea with scrollbars and below the code in a table with numbered lines.
I want to replace it with just code (or with just the table, which I can successfully convert to text), by removing the textarea.
Did try to do it like this
Sub RemoveTextBoxes()
Dim oFld As Word.FormField
With Application.ActiveDocument
' \\ TextInput Type requires to unprotect the document
If .ProtectionType <> wdNoProtection Then .Unprotect
' \\ Loop all formfields in active document
For Each oFld In .FormFields()
' \\ Only remove Formfield textboxes that have textinput only
If oFld.Type = wdFieldFormTextInput And oFld.TextInput.Type = wdRegularText Then
' \\ Delete
oFld.Delete
End If
Next
' \\ Reprotect the document
.Protect wdAllowOnlyFormFields, True
End With
End Sub
If I press Alt+F9 (displays field codes) I do see now
{ HTMLCONTROL Forms.HTML :TextArea.1 }
above the text box with scrollbars! If I close and open up again, it's still here.
How do I get this TextArea content and remove|replace the element with the content?

Dynamic content in Word is managed using "fields". Not all fields that accept input are "form fields", as you discovered when using Alt+F9 do display the field codes.
Word's Find / Replace functionality is quite powerful: it can also be used to find fields, even specific fields. In this case, since you simply want them removed, the HTMLControl fields can be found and replaced with "nothing". (If you want to be more specific and leave some HTMLControl fields, use as much text as necessary to remove only those fields.)
Many people don't realize it, but you can search field codes without needing to display them. Find can also work with field results displayed. The trick is to set the Range.TextRetrievalMode to include field codes (and, in this case, I think also inlcuding hidden text is a good idea, but if that's a problem, comment out or delete that line).
The ^d in the search text represents the opening field bracket: { - if this were left out only what is inside the brackets would be replaced (deleted), which I don't recommend. With ^d the entire field - including the closing bracket - is affected.
Sub FindAndDeleteHtmlFields()
Dim doc As word.Document
Dim fld As word.Field
Dim rngFind As word.Range
Set doc = ActiveDocument
Set rngFind = doc.content
rngFind.TextRetrievalMode.IncludeFieldCodes = True
rngFind.TextRetrievalMode.IncludeHiddenText = True
With rngFind.Find
.Text = "^d HTMLControl"
.ClearFormatting
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With
End Sub
Note that this also ports to C# - I have the impression that's actually where you're working...

Related

Finding and Replacing with VBA for Word overwrites previous style

I'm writing a VBA script to generate word documents from an already defined template. In it, I need to be able to write headings along with a body for each heading. As a small example, I have a word document that contains only <PLACEHOLDER>. For each heading and body I need to write, I use the find-and-replace feature in VBA to find <PLACEHOLDER> and replace it with the heading name, a newline, and then <PLACEHOLDER> again. This is repeated until each heading name and body is written and then the final <PLACEHOLDER> is replaced with a newline.
The text replacing works fine, but the style I specify gets overwritten by the next call to the replacement. This results in everything I just replaced having the style of whatever my last call to my replacement function is.
VBA code (run main)
Option Explicit
Sub replace_stuff(search_string As String, replace_string As String, style As Integer)
With ActiveDocument.Range.Find
.Text = search_string
.Replacement.Text = replace_string
.Replacement.style = style
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchWholeWord = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
End Sub
Sub main()
Dim section_names(2) As String
section_names(0) = "Introduction"
section_names(1) = "Background"
section_names(2) = "Conclusion"
Dim section_bodies(2) As String
section_bodies(0) = "This is the body text for the introduction! Fetched from some file."
section_bodies(1) = "And Background... I have no issue fetching data from the files."
section_bodies(2) = "And for the conclusion... But I want the styles to 'stick'!"
Dim i As Integer
For i = 0 To 2
' Writes each section name as wsStyleHeading2, and then the section body as wdStyleNormal
Call replace_stuff("<PLACEHOLDER>", section_names(i) & Chr(11) & "<PLACEHOLDER>", wdStyleHeading2)
Call replace_stuff("<PLACEHOLDER>", section_bodies(i) & Chr(11) & "<PLACEHOLDER>", wdStyleNormal)
Next i
Call replace_stuff("<PLACEHOLDER>", Chr(11), wdStyleNormal)
End Sub
Input document: A word document with only <PLACEHOLDER> in it.
<PLACEHOLDER>
Expected Output:
I expect that each heading will be displayed in the style I specified and can be viewed from the navigation pane like this:
Actual Output: However what I actually get is everything as wdStyleNormal style like this:
I think the problem can be solved by inserting a paragraph break between every style transition, but when I try using vbCrLF or Chr(10) & Chr(13) or vbNewLine instead of the chr(11) I am using now, Each line begins with a boxed question mark like this:
Update from discussion in comments on another answer. The problem described below applies to Word 2016 and earlier. Starting in Office 365 (and probably Word 2019, but that's not been confirmed) the Replace behavior has been changed to "convert" ANSI 13 to a "real" paragraph mark, so the problem in the question would not occur.
Answer
The reason for the odd formatting behavior is the use of Chr(11), which inserts a new line (Shift + Enter) instead of a new paragraph. So a paragraph style applied to any part of this text formats the entire text with the same style.
In this particular case (working with Replace), vbCr or the equivalent Chr(13) also don't work because these are not really Word's native paragraph. A paragraph is much more than just ANSI code 13 - it contains paragraph formatting information. So, while the code is running, Word is not really recognizing these as true paragraph marks and the paragraph style assignment is being applied to "everything".
What does work is to use the string ^p, which in Word's Find/Replace is the "alias" for a complete paragraph mark. So, for example:
replace_stuff "<PLACEHOLDER>", section_names(i) & "^p" & "<PLACEHOLDER>", wdStyleHeading2
replace_stuff "<PLACEHOLDER>", section_bodies(i) & "^p" & "<PLACEHOLDER>", wdStyleNormal
There is, however, a more efficient way to build a document than inserting a placeholder for each new item and using Find/Replace to replace the placeholder with the document content. The more conventional approach is to work with a Range object (think of it like an invisible selection)...
Assign content to the Range, format it, collapse (like pressing right-arrow for a selection) and repeat. Here's an example that returns the same result as the (corrected) code in the question:
Sub main()
Dim rng As Range
Set rng = ActiveDocument.content
Dim section_names(2) As String
section_names(0) = "Introduction"
section_names(1) = "Background"
section_names(2) = "Conclusion"
Dim section_bodies(2) As String
section_bodies(0) = "This is the body text for the introduction! Fetched from some file."
section_bodies(1) = "And Background... I have no issue fetching data from the files."
section_bodies(2) = "And for the conclusion... But I want the styles to 'stick'!"
Dim i As Integer
For i = 0 To 2
BuildParagraph section_names(i), wdStyleHeading2, rng
BuildParagraph section_bodies(i), wdStyleNormal, rng
Next i
End Sub
Sub BuildParagraph(para_text As String, para_style As Long, rng As Range)
rng.Text = para_text
rng.style = para_style
rng.InsertParagraphAfter
rng.Collapse wdCollapseEnd
End Sub
The problem is caused by your use of Chr(11) which is a manual line break. This results in all of the text being in a single paragraph. When the paragraph style is applied it applies to the entire paragraph.
Replace Chr(11) with vbCr to ensure that each piece of text is in a separate paragraph.

How can i change every occurence of a specific font ind a Word document?

i have following problem. Im currently creating a Macro that gets every font thats been used in a Word document. Afterwards it checks, if this font is even installed and changes the font into predefined fonts. (As the Microsoft auto-font-change in Word is pretty bad and changes my fonts into Comic Sans (no joke ...).
Everything works as intended except for one thing.
This here is the code i am using to exchange every occurence of the found
font in the document:
For i = 0 To UBound(missingFont)
For Each oCharacter In ActiveDocument.Range.Characters
If oCharacter.Font.name = missingFont(i) Then
oCharacter.Font.name = fontToUse
If InStr(missingFont(i), "bold") Then
oCharacter.Font.Bold = True
End If
If InStr(missingFont(i), "italic") Then
oCharacter.Font.Italic = True
End If
End If
Next oCharacter
Next i
So basically im checking every Character in my document and change it if needed. Now this only works for Characters that are not inside of textfields, the header or footer. How can i check every, EVERY, character inside of the Document?
First i've tried to use ActiveDocument.Range.Paragraphs instead of ActiveDocument.Range.Characters. I've also tried using the macro given here: http://www.vbaexpress.com/forum/showthread.php?55726-find-replace-fonts-macro but couldnt get this to work at all.
It's not clear what is meant by "textfield" as that could be any of five or six different things in Word...
But there is a way to access almost everything (excluding ActiveX controls) in a Word document by looping all StoryRanges. A StoryRange includes the main body of the document, headers, footers, footnotes, text ranges in Shapes, etc.
The following code sample demonstrates how to loop all the "Stories" in a document. I've put the code provided in the question in a separate procedure that's called from the "Stories" loop. (Note that I am not able to test, not having access to either the documents or relevant portions of code used in the question.)
Sub ProcessAllStories()
Dim doc as Word.Document
Dim missingFont as Variant
Dim myStoryRange as Word.StoryRange
'Define missingFont
Set doc = ActiveDocument
For Each myStoryRange In doc.StoryRanges
CheckFonts myStoryRange, missingFont
Do While Not (myStoryRange.NextStoryRange Is Nothing)
Set myStoryRange = myStoryRange.NextStoryRange
CheckFonts myStoryRange, missingFont
Loop
Next myStoryRange
End Sub
Sub CheckFonts(rng as Word.Range, missingFont as Variant)
Dim oCharacter as Word.Range
For i = 0 To UBound(missingFont)
For Each oCharacter In rng.Characters
If oCharacter.Font.name = missingFont(i) Then
oCharacter.Font.name = fontToUse
If InStr(missingFont(i), "bold") Then
oCharacter.Font.Bold = True
End If
If InStr(missingFont(i), "italic") Then
oCharacter.Font.Italic = True
End If
End If
Next oCharacter
Next i
End Sub

How do I make the last two words of each footnote bold using Word VBA?

I've changed balloon comments to footnotes, taking the author's name too. I need the author's name to be in bold but I can't get my code to read the footnotes. My problem is in setting : oFootnote
I've tried calling on the strAuthor and making that bold but because it is no longer a comment.author I can no longer set it as it's now in the footnote. I've tried many examples on the internet but I just can't get them to work:
StackOverflow's How do i make a string bold; Insert bold text into Word using VBA
also
Set oFootnote = oDoc.Footnotes.Add(Range:=Selection.Range, Text:="Some text")
I am a trainee so please don't judge me too harshly
'Convert comments to footnotes with Author name in bold
Dim i As Long
Dim oDoc As Document
dim oComment as Comments
Dim oFootnote As Footnotes
'Document is the ActiveDocument
Set oDoc = Application.ActiveDocument
'the author's name needs to be bold (the last two words in each footnote)
Set oFootnote = oDoc.Footnotes
With oFootnote
Selection.Range.Words.Last.Words (2)
'Make the last two words bold'
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Font.bold = True
End With
End With
Selection.Find.Execute
'Set oFootnote = Nothing
Next
I tried
Set oFootnote = oDoc.Footnotes Range:=Selection.Words.Last.Words(2)
but it doesn't like "Range:= onwards" so I did
Selection.Range.Words.Last.Words (2) invalid use of a property
There is usually more than one way to achieve something like this, but the key is usually to work with a dedicated Range object.
In the code below, that bases on the code in the question, the Range object is assigned to each individual Footnote object in a loop of the Footnotes. It is then collapsed to its end-point and the start extended backwards by two words. (To better understand how this works, think of selecting the footnote, pressing right-arrow, then pressing ctrl+shift+left arrow twice to select the last two words.)
Dim oDoc As Document
Dim oFootnotes As Footnotes
Dim Ftnote As Footnote
Dim rngFootnote As Word.Range
'Document is the ActiveDocument
Set oDoc = Application.ActiveDocument
'the author's name needs to be bold (the last two words in each footnote)
Set oFootnotes = oDoc.Footnotes
For Each Ftnote In oFootnotes
Set rngFootnote = Ftnote.Range
rngFootnote.Collapse wdCollapseEnd
rngFootnote.MoveStart wdWord, -2
rngFootnote.Font.Bold = True
Next
Note that the reason for one of the errors in the question is because Words.Last returns a Range object containing the last word. Since it contains only one word - the last - Words(2) can't find anything it can work with.
The reason for the other error is that it's not possible to assign a Range to a Footnote or Footnotes object. They're different things, entirely...
Not super familiar with word objects, but try this. Worked for my couple of tests.
Basically it loops through all foot notes. And uses the index of the word to set that word's bold property to true.
Sub Test()
Dim oFootNote As Footnote
Dim oLastIndex As Long
For Each oFootNote In ActiveDocument.Footnotes
oLastIndex = oFootNote.Range.Words.Count
If oLastIndex > 2 Then
oFootNote.Range.Words(oLastIndex).Bold = True
oFootNote.Range.Words(oLastIndex - 1).Bold = True
End If
Next
End Sub

Word VBA to control formatting and content of table cells in heading

Frequently, I have to change all headings of a word-document depending on a the content of a customproperty. For example, if the document prorperty 'Status' equeals to anything but final, all headings must contain 'DRAFT' written in bold characters on a red-background. If the document is 'final', DRAFT must not appear and the background must be 'none'.
Except for the first section, our headings contain a table consisting of one row and two cells. Cell 1 must be flipped depending on the 'Status', Cell 2 must remain unchanged.
Is there any known solution (VBA or cell-specific 'IF-THEN-ELSE Statements) to change the content of cell 1 throughout the whole document depending on the Status document property? Currently, I do have to scroll through all sections and change the header manually.
You can do this using a field and a macro. The field will create the values, and the macro will update them to account for changes.
Let's say that you're using the document property status as you've described. If the value is "DRAFT" the text in the table will be "This is a draft" and if it is anything else the text will be "This is not a draft". Word can be squirrely about these properties, so the first thing I would do is a test. Set your property to DRAFT and then create a field to ensure that Word is reading it.
Anywhere in your document type:
[Ctrl+F9] DOCPROPERTY Status
This will result in text that looks like
{DOCPROPERTY Status}
but be aware that you have to use Ctrl+F9 to get the special field brackets.
Now toggle the field code (select, right-click and choose Toggle Field Codes). If it becomes text that says DRAFT you are ready to go. If not, you may not be setting the property the way that Word wants you to. The way I do this is by going to Advanced Properties, clicking the Custom tab, finding Status in the list, adding the value, and clicking Add so that it appears below. There may be other ways, but that works.
Once you've had success with that field code, create a new one in your table that looks like this (remember that all brackets are created with Ctrl+F9):
{ IF { COMPARE { DOCPROPERTY Status } = "DRAFT" } = 1 "This is a draft" "This is not a draft" }
The If statement compares the value of the compare statement to 1, and the two quoted strings after reflect what will appear if the If statement evaluates to true, and what will appear if it evaluates to false. Toggle the field codes to see what you get.
Then, you can create a little macro that will update them all for you, so you don't have to manually update each one. Something like this should work:
Public Sub UpdateAllFields()
Dim objDoc as Document
Dim objSect As Section
Dim objHeader As HeaderFooter, objFooter As HeaderFooter
Set objDoc = ActiveDocument
objDoc.Fields.Update
For Each objSect In objDoc.Sections
For Each objHeader In objSect.Headers
objHeader.Range.Fields.Update
Next objHeader
For Each objFooter In objSect.Footers
objFooter.Range.Fields.Update
Next objFooter
Next objSect
End Sub
I misread and didn't realize the color change applied to these tables, so adding something about that.
The font color can be changed using the field. Change the field above so that it looks like this (remember about Ctrl+F9) (I'm adding some line breaks for readability. Do not include these in your field. Put it all on one line):
{ IF { COMPARE { DOCPROPERTY Status } = "DRAFT" } = 1
{ QUOTE "This is a draft" \*Charformat }
{ QUOTE "This is not a draft" \*Charformat } }
Then select each of the quote fields in turn and apply whatever font formatting you need. You can also apply highlighting in this way; I don't think this will be sufficient for your requirement to shade the whole cell but you might try it out and see if you can avoid additional steps.
If you definitely need to shade the whole cell, than you'll need another macro. Something like this should do it:
Sub ChangeCol()
Dim objDoc As Document
Dim objTable As Table, objCell As Cell
Dim objFld As Field
Set objDoc = ActiveDocument
For Each objFld In objDoc.Fields
If objFld.result.Information(wdWithInTable) = True And _
objFld.Code Like "*IF*" And _
objFld.Code Like "*DOCPROPERTY Status*" Then
If objDoc.CustomDocumentProperties("Status").Value = "DRAFT" Then
objFld.result.Cells(1).Shading.BackgroundPatternColor = wdColorRed
Else: objFld.result.Cells(1).Shading.BackgroundPatternColor = wdColorAutomatic
End If
End If
Next objFld
End Sub
Just run that along with the UpdateFields macro to keep them in sync (or write a third macro that triggers both of them so you don't forget).
Please accept my acknowledges once more. Hereafter, the macros I make use of for my purpose:
Private Sub colorizeTableCells(ByVal oFields As fields, sStatus As String)
Dim objFld As field
Dim bgColor As WdColor
oFields.Update
For Each objFld In oFields
If objFld.Result.Information(wdWithInTable) = True And _
objFld.Code Like "*IF*" And _
objFld.Code Like "*DOCPROPERTY Status*" Then
bgColor = wdColorAutomatic
If sStatus = "DRAFT" Then
bgColor = wdColorRed
End If
objFld.Result.Cells(1).Shading.BackgroundPatternColor = bgColor
End If
Next objFld
End Sub
Sub processHeaderAndFooterFields()
Dim objDoc As Document
Dim objSect As Section
Dim objHeader As HeaderFooter
Dim objFooter As HeaderFooter
Dim sStatus As String
Set objDoc = ActiveDocument
sStatus = objDoc.CustomDocumentProperties("Status").Value
For Each objSect In objDoc.Sections
For Each objHeader In objSect.Headers
colorizeTableCells oFields:=objHeader.range.fields, sStatus:=sStatus
Next objHeader
For Each objFooter In objSect.Footers
colorizeTableCells oFields:=objFooter.range.fields, sStatus:=sStatus
Next objFooter
Next objSect
End Sub

Check Word 2007 bookmark content and do something if it exists

Is it possible to search the content inside a bookmark and if it exists, do something.
For example, if there is a word document with a bookmark named Bookmark1. The enclosing text for Bookmark1 was created by highlighting the the text "Entered Text Goes Here". I want to create a macro that will check to see if the text inside the bookmark was changed, and if NOT, delete the text, the bookmark, the section break before it.
The code below does this except that it deletes the bookmark even if the text is different because it is looking for the name of the bookmark, not its content.
If ActiveDocument.Bookmarks.Exists("Bookmark1") = True Then
ActiveDocument.Bookmarks("Bookmark1").Select
Selection.Delete
With Selection
.EndKey Unit:=wdStory
.TypeBackspace
.Delete
End With
End If
I really want the If statement to say something like:
If the text inside the Bookmark1 = "Entered Text Goes Here" Then do all the stuff below, else quit.
Ideas anyone?
Word 2007.
The below should work if your document is set up how I think it is, otherwise you will need to have a play around with it:
'TestTxt is the default text in the bookmark (assuming that you are not including the paragraph mark in the bookmark)
Dim TestTxt As String: TestTxt = "Enter text here"
'DMRng is the range of the the bookmark you are looking at
Dim BMRng As Range: Set BMRng = ThisDocument.Bookmarks("Bookmark1").Range
If BMRng.Text = TestTxt Then
'Start is the beginning of the bookmark - 1 (as the character before hand should be your section break?!)
BMRng.SetRange Start:=BMRng.Start - 1, End:=BMRng.End
BMRng.Delete
End If