Get all cross references in word with VBA - vba

I have quite a large word document (> 400 pages) with lots of cross references to headings. So far, I have always referred to the title of the heading, but now I would like to change that and refer to the page the heading resides on.
I didn't find a solution to this via the GUI (except manual treatment, of course), so I was looking into writing some VBA. Unfortunately, I have only found a way to list all targets that can be cross referenced (via GetCrossReferenceItems), but I need a way to access the actual cross reference field.
Can you help me with that? Is a cross reference field the same as a hyperlink?

Cross-references are fields in a Word document, and can be accessed via the Fields collection (ActiveDocument.Fields). You can loop through them like any other collection and check their types to see if it's one you want to work on. It looks like cross-references to text are type 3 (wdFieldRef) and cross-references to page numbers are type 37 (wdFieldPageRef). Changing fields can be a little tricky; the following should get you started:
Sub ChangeFields()
Dim objDoc As Document
Dim objFld As Field
Dim sFldStr As String
Dim i As Long, lFldStart As Long
Set objDoc = ActiveDocument
' Loop through fields in the ActiveDocument
For Each objFld In objDoc.Fields
' If the field is a cross-ref, do something to it.
If objFld.Type = wdFieldRef Then
'Make sure the code of the field is visible. You could also just toggle this manually before running the macro.
objFld.ShowCodes = True
'I hate using Selection here, but it's probably the most straightforward way to do this. Select the field, find its start, and then move the cursor over so that it sits right before the 'R' in REF.
objFld.Select
Selection.Collapse wdCollapseStart
Selection.MoveStartUntil "R"
'Type 'PAGE' to turn 'REF' into 'PAGEREF'. This turns a text reference into a page number reference.
Selection.TypeText "PAGE"
'Update the field so the change is reflected in the document.
objFld.Update
objFld.ShowCodes = True
End If
Next objFld
End Sub

Related

Using VBA to Change Text Style in All Tables in a Word Document

I am trying to change the text style inside all tables in a document, and then bold the text in all columns of the first row. I currently have the following...
Sub AutoTableFormat()
Dim tbl As Table
For Each tbl In ActiveDocument.Tables
txt.Text.Style = ActiveDocument.Styles("Table Text")
Next
End Sub
The following give me an error saying Run-time error '5849': Could not apply the style. I am very new to VBA(just started today) and was hoping for some help. Honestly dont even know where to start with the bolding thing either. Thank you.
The Visual Basic Editor provides you with three tools to help with coding:
Intellisense - shows you the available properties and methods for objects as you type.
Object Browser - allows you to browse or search the object model
Online help
Although you start out well with a loop through the tables the line inside the loop is completely illogical. What exactly is the variable txt supposed to represent? Where is it declared? What relation does it have to tbl?
Had you used the tools at your disposal you would have discovered that a Table object has a Range which has a Style property. This would have given you:
Sub AutoTableFormat()
Dim tbl As Table
For Each tbl In ActiveDocument.Tables
tbl.Range.Style = ActiveDocument.Styles("Table Text")
Next
End Sub
Setting the format of the first column is awkward as the Column object does not have a Range. This means you have to loop through each cell of the first column to apply the formatting. A more efficient way of achieving your goal would be to create a table style with all your required formatting and then apply that.
Sub AutoTableFormat()
Dim tbl As Table
For Each tbl In ActiveDocument.Tables
tbl.Style = ActiveDocument.Styles("My Table Style")
tbl.ApplyStyleFirstColumn
Next
End Sub

Batch add formatted autocorrects with VBA in Word

I use a long Excel spreadsheet containing incorrect and correct terms to check consistency between documents (e.g. anti-citrullinated is always hyphenated). I've added quite a few of these as autocorrect entries via the AutoCorrect Options feature in Word but it's time-consuming .
I came across the following code that will add long lists of autocorrects.
Sub BatchAddAutoCorrectEntries()
Dim objTable As Table
Dim objOriginalWord As Cell
Dim objOriginalWordRange As Range
Dim objReplaceWordRange As Range
Dim nRowNumber As Integer
Set objTable = ActiveDocument.Tables(1)
nRowNumber = 1
For Each objOriginalWord In objTable.Columns(1).Cells
Set objOriginalWordRange = objOriginalWord.Range
objOriginalWordRange.MoveEnd Unit:=wdCharacter, Count:=-1
Set objReplaceWordRange = objTable.Cell(nRowNumber, 2).Range
objReplaceWordRange.MoveEnd Unit:=wdCharacter, Count:=-1
AutoCorrect.Entries.Add Name:=objOriginalWordRange.Text, Value:=objReplaceWordRange.Text
nRowNumber = nRowNumber + 1
Next objOriginalWord
MsgBox ("All autocorrect items in the table1 are added.")
End Sub
It doesn't preserve any formatting: super- or subscripts, etc. Formatting autocorrect entries are stored in the Normal.dotm file and not in the regular .acl file so I haven't been able to figure out a way around this.
In a similar post, someone suggested a Find and Replace macro but Find and Replace doesn't allow me to replace with super- or subscripts.
There are two methods of adding Auto Correct Entries, Add and AddRichText. It is this second one that you use for formatted entries.
When faced with an issue like this my first resort is to check the Object Brower in the VBA editor (press F2 to display) to see what methods and properties may be available. My next step is to look them up in the VBA technical reference, aka Help, to check the usage.
If the problem is just sub/superscribt, then you could use uni-codes. Those are also available in autocorrect. Fx writing the unicodes ₁₂₃₄₅₆₇₈₉ instead of using formating on a normal 2. Most (but not all) characters exist in super and sub unicode.
The program is not working. It is giving an error message
Compile Error Expected Function or Variable
It is showing the following line as error
Autocorrect.Entries.Add Name:=objOriginalWordRange.Text, Value:=objReplaceWordRange.Text

Access table object based on current paragraph

I am iterating through all paragraphs in a document and want to identify their indent level. While this works most of the time using Paragraph.Format.LeftIndent, it does not work for paragraphs within tables. In particular in cases when the paragraph itself is not indented but the table has a left indent.
Is there any way to navigate from the currelty selected paragraph to the table where it is located in? I know there is the property "wdWithInTable" but this is not enough for me because I need the Table object to check its LeftIndent property.
Go get table from current selection use this logic:
Sub GetTable()
Dim currentTable As Table
Set currentTable = Selection.Tables(1)
'test purpose only
Debug.Print currentTable.Rows.Count, currentTable.Columns.Count
'and to get table indention try with this
Debug.Print currentTable.Range.ParagraphFormat.LeftIndent
End Sub

Insert text after numbers and before words in a Word hierarchical heading

I am working my way through two books (Roman's Writing Word Macros, Mansfield's Mastering VBA for MS Office). In my work environment, I use both Word 2007 and Word 2010.
My issue is that I want to use VBA to insert a very brief amount of standardized text before the English-language string in my numbered hierarchical headings. For instance, I have:
1.1.1 The Quick Brown Fox.
What I want is:
1.1.1 (XXxx) The Quick Brown Fox.
I guess my most basic issue is that I don't know how to approach the situation. I have hierarchical headings yet I don't know how to say, in effect, "Go to each hierarchical heading regardless of level. Insert yourself in front of the first English language word of the heading. Paste the text "XXxx" in front of the first word in the heading. Go on to the next heading and all remaining headings and do the same. My document is over 700 pages and has hundreds of hierarchical headings.
I see that paragraphs are objects and that hierarchical headings are paragraphs. However, I can't see any way to make VBA recognize what I am talking about. I haven't been able to use Selection approaches successfully. I've tried using the Range approach but just have not been able to phrase the VBA code intelligently. I haven't been able to specify a range that includes all and only the hierarchical headings and, especially, I don't understand how to get the insertion to happen in front of the first English-language word of the heading.
I have just begun to look at using Bookmarks. However, don't bookmarks require me to go to every heading and enter them? I may as well just paste my content if that is the case. I'm stumped. It is interesting that in no way, as might have been expected, does this appear to be a simple matter
Assuming you are using Word's outline levels (I think this is what you mean by hierarchical headings), you can check a paragraph for this state. For example, assuming I have a paragraph in my document that has the Heading 1 style applied to it:
Sub PrintHeadings()
Dim objDoc as Document
Dim objPara as Paragraph
Set objDoc = ActiveDocument
For each objPara in objDoc.Content.Paragraphs
If objPara.OutlineLevel <> wdOutlineLevelBodyText then
Debug.Print objPara.Range.Text
End If
Next objPara
End Sub
This code would print the contents of any paragraph that has an outline level above body text to the VBA Immediate Window. There are other approaches as well; you could use Find and Replace to search for each of the Outline Levels. This gives you a bit less control; you'd want your change to be something that could be encapsulated in a Word Find and Replace. But, it would be faster if you have a long document and not too many heading levels. A basic example:
Sub UnderlineHeadings()
Dim objDoc as Document
Set objDoc = ActiveDocument
With objDoc.Content.Find
.ClearFormatting
.ParagraphFormat.OutlineLevel = wdOutlineLevel1
With .Replacement
.ClearFormatting
.Font.Underline = wdUnderlineSingle
End With
.Execute Forward:=True, Wrap:=wdFindContinue, Format:=True, Replace:=wdReplaceAll
End With
End Sub
That would underline all of your text of Outline Level 1.
Perhaps that will get you started.
I asked this question some months ago: "My issue is that I want to use VBA to insert a very brief amount of standardized text before the English-language string in my numbered hierarchical headings." By "numbered hierarchical headings" I meant Word multilevel lists. The answers I received were appreciated but did not respond effectively to my question or guide me to a resolution. I pass this along in the hope it may be of use to others.
First, the "number" part of the Word heading is irrelevant. In writing your code, there is NO need to think of a "number" portion and a "text" portion of the heading. I was afraid that any text I was trying to insert would be inserted BEFORE the multilevel numbering rather than BEFORE the English language text. The multilevel numbering is apparently automatically ignored. Below are two solutions that worked.
This first macro succeeded in producing the desired result: 1.1.1 (FOUO). I used this macro to create individual macros for each order of heading. I haven't learned how to combine them all into one macro. But they work individually (but not without the flaw of taking too much time ~5 to 10 minutes for a complex, paragraph-heavy 670 page document).
Public Sub InsertFOUOH1()
Dim doc As Document
Dim para As Paragraph
Dim paraNext As Paragraph
Dim MyText As String
Dim H1 As HeadingStyle
Set doc = ActiveDocument
Set para = doc.Paragraphs.First
Do While Not para Is Nothing
Set paraNext = para.Next
MyText = "(U//FOUO) "
If para.Style = doc.Styles(wdStyleHeading1) Then
para.Range.InsertBefore (MyText)
End If
Set para = paraNext
Loop
End Sub
THIS WORKS ON ALL FIRST ORDER HEADINGS (1, 2, 3 ETC.)
I used the macro below to add my security marking all body paragraphs:
Public Sub InsertFOUObody()
'Inserts U//FOUO before all body paragraphs
Dim doc As Document
Dim para As Paragraph
Dim paraNext As Paragraph
Dim MyText As String
Set doc = ActiveDocument
Set para = doc.Paragraphs.First
Do While Not para Is Nothing
Set paraNext = para.Next
MyText = "(U//FOUO) "
If para.Style = doc.Styles(wdStyleBodyText) Then
para.Range.InsertBefore (MyText)
End If
Set para = paraNext
Loop
End Sub
These macros are running slowly and, at the end, generating Error 28 Out of stack space errors. However the error is displayed at the end of running the macros and after the macros have successfully performed their work.

Distinguishing Table of Contents in Word document

Does anyone know how when programmatically iterating through a word document, you can tell if a paragraph forms part of a table of contents (or indeed, anything else that forms part of a field).
My reason for asking is that I have a VB program that is supposed to extract the first couple of paragraphs of substantive text from a document - it's doing so by iterating through the Word.Paragraphs collection. I don't want the results to include tables of contents or other fields, I only want stuff that a human being would recognize as a header, title or a normal text paragraph. However it turns out that if there's a table of contents, then not only the table of contents itself but EVERY line in the table of contents appears as a separate item in Word.Paragraphs. I don't want these but haven't been able to find any property on the Paragraph object that would allow me to distinguish and so ignore them (I'm guessing I need the solution to apply to other field types too, like table of figures and table of authorities, which I haven't yet actually encountered but I guess potentially would cause the same problem)
Because of the limitations in the Word object model I think the best way to achieve this would be to temporarily remove the TOC field code, iterate through the Word document, and then re-insert the TOC. In VBA, it would look like this:
Dim doc As Document
Dim fld As Field
Dim rng As Range
Set doc = ActiveDocument
For Each fld In doc.Fields
If fld.Type = wdFieldTOC Then
fld.Select
Selection.Collapse
Set rng = Selection.Range 'capture place to re-insert TOC later
fld.Cut
End If
Next
Iterate through the code to extract paragraphs and then
Selection.Range = rng
Selection.Paste
If you are coding in .NET this should translate pretty closely. Also, this should work for Word 2003 and earlier as is, but for Word 2007/2010 the TOC, depending on how it is created, sometimes has a Content Control-like region surrounding it that may require you to write additional detect and remove code.
This is not guaranteed, but if the standard Word styles are being used for the TOC (highly likely), and if no one has added their own style prefixed with "TOC", then it is OK. This is a crude approach, but workable.
Dim parCurrentParagraph As Paragraph
If Left(parCurrentParagraph.Format.Style.NameLocal, 3) = "TOC" Then
' Do something
End If
What you could do is create a custom style for each section of your document.
Custom styles in Word 2003 (not sure which version of Word you're using)
Then, when iterating through your paragraph collection you can check the .Style property and safely ignore it if it equals your TOCStyle.
I believe the same technique would work fine for Tables as well.
The following Function will return a Range object that begins after any Table of Contents or Table of Figures. You can then use the Paragraphs property of the returned Range:
Private Function GetMainTextRange() As Range
Dim toc As TableOfContents
Dim tof As TableOfFigures
Dim mainTextStart As Long
mainTextStart = 1
For Each toc In ActiveDocument.TablesOfContents
If toc.Range.End > mainTextStart Then
mainTextStart = toc.Range.End + 1
End If
Next
For Each tof In ActiveDocument.TablesOfFigures
If tof.Range.End > mainTextStart Then
mainTextStart = tof.Range.End + 1
End If
Next
Set GetMainTextRange = ActiveDocument.Range(mainTextStart, ActiveDocument.Range.End)
End Function