VBA Nuggets

This Microsoft Word Tips & Microsoft Word Help page is a continuous work in progress and a repository for a hodgepodge collection of usually short, sometimes simple and hopefully helpful VBA procedures intended to assist in Word document processing, overcome bugs and make life easier for Word users in general.

It will start life with just few procedures, but hopefully will grow and become more helpful with time.

If you need help employing the VBA procedures published here then see my: Install/Employ VBA Procedures (Macros)

Word 2013 - VBA Print Current Page Bug

There is (or at least was) a bug in Word 2013 where the wdPrintCurrentPage constant fails to print the current page and prints the document first page instead. You can work around that bug using the following method:

VBA Script:

Copy to clipboard

Sub Word2013PrintCurrentPage()
Dim strPgNum as String
  strPgNum = Selection.Information(wdActiveEndAdjustedPageNumber)
  Application.PrintOut Range:=wdPrintFromTo, From:=strPgNum, To:=strPgNum
lbl_Exit:
  Exit Sub
End Sub

Get Cell Text (Strip End of Cell Mark)

When you are working with documents containing tables, you often need to determine the text contained in the cell range and strip the end of cell mark from the text string.

Unfortunately, the Cell.Range.Text property includes the end of cell mark. The end of cell mark is a rather odd bird. While appearing as a single character, with a range span = 1, it is actually composed of two characters ChrW(13) and Chr(7) with a text length = 2. Here I provide a demonstration of five methods you can use to return the text string of a table cell and strip the end of cell mark. Take your pick:

VBA Script:

Copy to clipboard

Sub DemoMethods()
'This demo requires an active document containing at least one table.
  'Passing the cell object using its row and column index as the argument.
  MsgBox fcnGetCellText1(ActiveDocument.Tables(1).Cell(1, 1))
  MsgBox fcnGetCellText2(ActiveDocument.Tables(1).Cell(1, 1))
  MsgBox fcnGetCellText3(ActiveDocument.Tables(1).Cell(1, 1))
  'Passing a range object as the argument.
  MsgBox fcnGetCellText4(ActiveDocument.Tables(1).Cell(1, 1).Range)
  MsgBox fcnGetCellText5(ActiveDocument.Tables(1).Cell(1, 1).Range)
lbl_Exit:
  Exit Sub
End Sub

Function fcnGetCellText1(ByRef oCell As Word.Cell) As String
  fcnGetCellText1 = Left(oCell.Range.Text, Len(oCell.Range.Text) - 2)
lbl_Exit:
  Exit Function
End Function

Function fcnGetCellText2(ByRef oCell As Word.Cell) As String
Dim oRng As Word.Range
  Set oRng = oCell.Range
  oRng.MoveEnd wdCharacter, -1
  fcnGetCellText2 = oRng.Text
lbl_Exit:
  Exit Function
End Function

Function fcnGetCellText3(ByRef oCell As Word.Cell) As String
  'Replace the end of cell marker with a null string.
  fcnGetCellText3 = Replace(oCell.Range.Text, ChrW(13) & ChrW(7), vbNullString)
lbl_Exit:
  Exit Function
End Function

Function fcnGetCellText4(ByRef oRng As Word.Range) As String
  oRng.End = oRng.End - 1
  fcnGetCellText4 = oRng.Text
lbl_Exit:
  Exit Function
End Function

Function fcnGetCellText5(ByRef oRng As Word.Range) As String
  oRng.Collapse wdCollapseStart
  'Expand the range to the paragraph mark _
  (the first part of the the ChrW(13) & ChrW(7) end of cell mark)
  oRng.Expand
  fcnGetCellText5 = oRng.Text
lbl_Exit:
  Exit Function
End Function

Populate (fill in) Bookmarks

Document bookmarks are easy to create and provide a convenient range target when working with VBA.

Text Values

For example, you might want to fill in a bookmark with the text value your document user provides in and input box:

VBA Script:

Copy to clipboard

Sub DemoWriteToBookmark()
'Assumes that the active document contains a bookmark named bmClientName.
  WriteToBM "bmClientName", InputBox("Enter your name", "Client Name")
lbl_Exit:
  Exit Sub
End Sub

Public Sub WriteToBM(ByVal strBMName As String, ByVal strText As String)
Dim oRng As Word.Range
  If ActiveDocument.Bookmarks.Exists(strBMName) Then
    Set oRng = ActiveDocument.Bookmarks(strBMName).Range
    oRng.Text = strText
    'Writing text "at" as bookmark range destroys the bookmark.
    'Recreate it.
    ActiveDocument.Bookmarks.Add strBMName, oRng
  End If
lbl_Exit:
  Exit Sub
End Sub

Objects

Bookmarks can encompass (or define) practically any range. You might want to use a document bookmark to define the range target when inserting objects such as fields, pictures, or complete files in your Word document. The following demonstrates populating a bookmark range with a picture:

VBA Script:

Copy to clipboard

Sub DemoInsertPictureInBookmark()
'Assumes you have a graphics file named "Demo Picture.jpg" saved in the C:\ root
'directory and a bookmark named bmPicture in the activeDocument.
  InsertPictureInBookmarkRange "bmPicture", "C:\Demo Picture.jpg"
lbl_Exit:
  Exit Sub
End Sub

Sub InsertPictureInBookmarkRange(strBMName As String, strPath As String)
Dim oRng As Word.Range
Dim oILS As InlineShape
  Set oRng = ActiveDocument.Bookmarks(strBMName).Range
  'Clear range to ensure bookmark range is empty of any previous content.
  oRng.Delete
  Set oILS = oRng.InlineShapes.AddPicture(FileName:=strPath, LinkToFile:=False, _
             SaveWithDocument:=True)
  'Redefine the range to encompass the graphic.
  Set oRng = oILS.Range
  'Recreate the bookmark.
  ActiveDocument.Bookmarks.Add "PictureBM", oRng
lbl_Exit:
  Exit Sub
End Sub

Hide Empty Content Controls (Do not print Placeholder Text)

Incomplete content controls can appear out of place if not down right odd in a printed document.

The following macro evaluates each content control in the main text region of a document and sets the placeholder text to a zero width space if placeholder text is showing:

VBA Script:

Copy to clipboard

Sub HidePlaceholderText()
'A basic Word macro coded by Greg Maxey
Dim oCC As ContentControl
  For Each oCC In ActiveDocument.ContentControls
    If oCC.ShowingPlaceholderText Then
      'Set the placeholder text to a zero width space.
      oCC.SetPlaceholderText , , ChrW(8203)
    End If
  Next oCC
lbl_Exit:
  Exit Sub
End Sub

For more on placeholder text see my: Content Controls - Do Not Print Placeholder Text

Simple VBA Find & Replace

When you use Word Find and Replace tools with the UI, Word can quickly find all instances of the find text throughout the document. In a simple VBA Find & Replace procedure, the search range is limited to a single storyrange.

For example, using the following procedure, you can find and replace all instances of the word "test" throughout the main text storyrange of the document. However, instances of the word "test" located in other storyranges (e.g., headers, footers, footnotes, etc.) will not be found or processed.

VBA Script:

Copy to clipboard

Sub SimpleFindReplace()
Dim oRng As Range
Dim strFind As String, strReplace As String
  Set oRng = ActiveDocument.Range
  strFind = "Test"
  strReplace = "Replacement Test"
  With Selection.Find
    .ClearFormatting
    .Replacement.ClearFormatting
  End With
  With oRng.Find
    .MatchWildcards = False
    .MatchWholeWord = True
    .Text = strFind
    .Replacement.Text = strReplace
    .Forward = True
    .Wrap = wdFindContinue
    .Execute Replace:=wdReplaceAll
  End With
lbl_Exit:
  Exit Sub
End Sub

To find instances of "test" in the other storyranges, you will need to modify the "Set oRng = ..." line to define the storyrange of the text you want to search.

Multiple Find and Replace Pairs

With a slightly modified version of the code above, you can find and replace multiple find and replace word\phrase pairs in active document main text storyrange (or any other storyrange.)

You will need a supporting Word document containing a single 2 column table. In column 1 list the text you want to find. In column 2 list the replacement text. Save the list e.g., D:\FRList.docx.

Place the cursor in the storyrange you want to process and run the procedure.

VBA Script:

Copy to clipboard

Sub ReplaceFromTableList()
Dim oListDoc As Document, oDoc As Document
Dim strFile_Path As String
Dim lngType As Long, lngIndex as Long
Dim oTbl As Table
Dim oRng As Range
Dim strFind As String, strReplace As String

  'What to search
  Set oDoc = ActiveDocument
  'Where to search. Put your cursor in the storyrange you want to search.
  lngType = Selection.Range.StoryType
  'What to search for and replace with. Change path below reflect
  'the path and name the document containing a two column Find/Replace pair table.
  strFile_Path = "D:\FRList.docx"
  'Handle possible errors.
  On Error GoTo Err_Handler
  'Open list file.
  Set oListDoc = Documents.Open(FileName:=strFile_Path, Visible:=False)
  Set oTbl = oListDoc.Tables(1)
  For lngIndex = 1 To oTbl.Rows.Count
    'Set the search range. A simple VBA F&R does not search all storyranges.
    Set oRng = oDoc.StoryRanges(lngType)
    strFind = oTbl.Cell(lngIndex, 1).Range.Text '*
    strFind = Left(strFind, Len(strFind) - 2)
    strReplace = oTbl.Cell(lngIndex, 2).Range.Text
    strReplace = Left(strReplace, Len(strReplace) - 2)
    With oRng.Find
     .ClearFormatting
     .Replacement.ClearFormatting
     .MatchWildcards = False
     .MatchWholeWord = True '**
     .Text = strFind
     .Replacement.Text = strReplace
     .Forward = True
     .Wrap = wdFindContinue
     .Execute Replace:=wdReplaceAll
    End With
  Next lngIndex
  oListDoc.Close wdDoNotSaveChanges
lbl_Exit:
  Exit Sub
Err_Handler:
Select Case Err.Number
Case 5941: MsgBox "The source table is missing or missing a required column."
Case Else: MsgBox Err.Description
End Select
Resume lbl_Exit
End Sub

Notes: * See if you can adapt this simple code to get the cell text using one of the functions designed for that purpose above. ** There is no option to match whole words if the find text string consists of two or more words. In such cases, this property is ignored.

For more on VBA Find and Replace see my add-in designed for this purpose.

Table to Array

Often for basic projects you may want to use a Word table as a data source and convert it to an array for processing. This can be easily done using a pair of functions.

VBA Script:

Copy to clipboard

Function fcnTableToArray(oTbl As Word.Table, _
                         Optional bHeadingRow As Boolean = True) As String()
'Returns as two dimensional array containing the contents of a Word table
Dim lngIndex As Long, lngOffset As Long, lngCols As Long, lngCol As Long
Dim arrTemp() As String
  lngOffset = IIf(bHeadingRow, 2, 1)
  lngCols = oTbl.Columns.Count
  For lngIndex = 0 To oTbl.Rows.Count - lngOffset
    ReDim Preserve arrTemp(lngCols - 1, lngIndex)
    For lngCol = 1 To lngCols
      arrTemp(lngCol - 1, lngIndex) = fcnGetCellText(oTbl.Cell(lngIndex + lngOffset, lngCol))
    Next lngCol
  Next lngIndex
  fcnTableToArray = arrTemp
lbl_Exit:
  Exit Function
End Function

Function fcnGetCellText(ByRef oCell As Word.Cell) As String
'Replace the end of cell marker with a null string.
  fcnGetCellText = Replace(oCell.Range.Text, ChrW(13) & ChrW(7), vbNullString)
lbl_Exit:
  Exit Function
End Function

Call it using something like this:

VBA Script:

Copy to clipboard

Sub DemoTableToArray()
Dim oDoc As Document
Dim arrData() As String
Dim lngX As Long, lngY As Long
  'Document containing the table to convert to an array.
  Set oDoc = Documents.Open(FileName:="C:\Data.docx", Visible:=False)
  If oDoc.Tables(1).Uniform Then
    arrData = fcnTableToArray(oDoc.Tables(1))
    'To process data as it appears left to right then down the table:
    For lngY = 0 To UBound(arrData, 2)
      For lngX = 0 To UBound(arrData, 1)
        Debug.Print arrData(lngX, lngY)
      Next lngX
    Next lngY
    'To process data as it appears down the table then left to right:
    For lngX = 0 To UBound(arrData, 1)
      For lngY = 0 To UBound(arrData, 2)
        Debug.Print arrData(lngX, lngY)
      Next lngY
    Next lngX
  Else
    MsgBox "Table is not uniform" & vbCr + vbCr _
         & "To create an array the table may not contain merged or split cells", _
            vbInformation + vbOkOnly, "NON-UNIFORM TABLE"
  End If
  oDoc.Close wdDoNotSaveChanges
lbl_Exit:
  Exit Sub
End Sub

Trim Cell Text

If you have extraneous leading or trailing text in table cells, you can easily remove it by simply selecting the table text (not the entire table) and then using the paragraph alignment controls on the Home tab:

You can record a macro performing those steps and the resulting macro is:

Sub Macro1()
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
End Sub

My experience is that you can select text in a table as shown above and run that macro until the cows come home and it makes no difference at all. I don't know why.

The following macro works however and can be easily adapted and applied to all tables in a document:

VBA Script:

Copy to clipboard

Sub TrimCellText()
Dim oTbl As Table, oCell As Cell, oRng As Range
  Set oTbl = Selection.Tables(1)
  'For Each oTbl In ActiveDocument.Tables
    For Each oCell In oTbl.Range.Cells
      Set oRng = oCell.Range
      oRng.End = oRng.End - 1
      oRng.Text = Trim(oRng.Text)
    Next oCell
  'Next oTbl
lbl_Exit:
  Set oTbl = Nothing: Set oCell = Nothing: Set oRng = Nothing
  Exit Sub
End Sub

Reset Check Spelling (Really)

There is a bug in all known version of Word that makes it cumbersome to recheck document spelling using VBA. The culprit is a broken ".SpellingChecked" property and a fuzzy application method ".ResetIgnoreAll." The .SpellingChecked property is supposed to be a Read\Write property but apparently never learned to write.

To illustrate, create new blank document and type a short phrase containing a single spelling error. Then run this code:

VBA Script:

Copy to clipboard

Sub Bug_Demo()
  'Start with a document containing a single spelling error.
  ActiveDocument.CheckSpelling 'Spell checker starts.
  'Select option to ignore all.
  ActiveDocument.Range.SpellingChecked = False 'Won't take.
  MsgBox ActiveDocument.Range.SpellingChecked 'Returns True.
  Application.ResetIgnoreAll
  ActiveDocument.Range.SpellingChecked = False 'Still won't take.
  MsgBox ActiveDocument.Range.SpellingChecked 'Still returns True.
  ActiveDocument.CheckSpelling 'Spell checker won't start.
lbl_Exit:
  Exit Sub
End Sub

Now, if you want to save an close your document, shutdown and restart Word, reopen your document and then run the following code, it will work:

VBA Script:

Copy to clipboard

Sub Bug_RoundAboutWorkAround()
  ActiveDocument.SpellingChecked = False
  Application.ResetIgnoreAll
  ActiveDocument.CheckSpelling
lbl_Exit:
  Exit Sub
End Sub

You can avoid having to shutdown and restart Word by using File>Options>Proofing and select the command "Recheck Document." Yes, this works but it is hardly a VBA solution!

The intuitive solution would be to simply record a macro of your manual actions. Aghast! Unfortunately, the macro recorded is similar to the work around above and only works if Word is closed and restarted:

Application.ResetIgnoreAll
ActiveDocument.SpellingChecked = False
ActiveDocument.GrammarChecked = False

Sometimes you just need a hammer:

VBA Script:

Copy to clipboard

Sub Bug_Fix()
  'Start with a document containing a single spelling error.
  ActiveDocument.CheckSpelling 'Spell checker starts.
  ResetWithHammer
  ActiveDocument.CheckSpelling 'Spell checker starts.
lbl_Exit:
  Exit Sub
End Sub

Sub ResetWithHammer()
  Application.Run MacroName:="FileNewDialog" 'Access Backstage view
  SendKeys "%TP" 'Options|Proofing
  SendKeys "%K" 'Recheck Document button
  SendKeys "%Y" 'Yes button for confirmation message box
  SendKeys "{ENTER}", True 'Exit the dialog box
lbl_Exit:
  Exit Sub
End Sub

Word Basic Commands

Word Basic went to the sidelines with the introduction of VBA in Word 97. For all the tools VBA brought to the Office Developer's disposal, there are a few very useful Word Basic command with no direct VBA equivalent.

Sort Array

That's it! I hope you have found this tips page useful and informative.

	Enter your search terms Submit search form
	Web gregmaxey.com

VBA Nuggets(A Microsoft Word Help & Tip page by Gregory K. Maxey)

Word 2013 - VBA Print Current Page Bug

Get Cell Text (Strip End of Cell Mark)

Populate (fill in) Bookmarks

Text Values

Objects

Hide Empty Content Controls (Do not print Placeholder Text)

Simple VBA Find & Replace

Multiple Find and Replace Pairs

Table to Array

Trim Cell Text

Reset Check Spelling (Really)

Word Basic Commands

Sort Array

VBA Nuggets
(A Microsoft Word Help & Tip page by Gregory K. Maxey)