Counting Characters in Text Boxes

If you have a document that includes text in various text boxes, you should understand that if you do a word count, Word does not include the words in the text boxes in the word count it returns. If you want to only know the number of words in a text box, there is a way around this: Just select the text box whose words you want to count before you initiate the Word Count function. Word then dutifully counts only the words in the text box, ignoring the rest of the document.

There is one time when this select-before-count technique will not work, however. If you have multiple text boxes containing words, and those text boxes are grouped, then the Word Count function will not recognize them as "countable" if you select the group. In other words, to count the characters in the text boxes that make up the group, you must first ungroup the group and then count each text box.

Obviously, this can get tedious to do over and over again. One way around this is to use a macro that performs these same steps for you. The following macro, TextBoxCount, steps through all the shapes in your document. If they are grouped, then they are automatically ungrouped. It then executes a word count on each text box, and returns a dialog box that indicates the number of words and characters in the text boxes (collectively) and the number of words and characters in the entire document, including the text boxes.

Sub TextBoxCount()
    Dim lngTBWords As Long
    Dim lngTBChars As Long
    Dim lngDocWords As Long
    Dim lngDocChars As Long
    Dim shpTemp As Shape
    Dim wcTemp As Dialog
    Dim bDone As Boolean

    Application.ScreenUpdating = False

    Do
        bDone = True
        For Each shpTemp In ActiveDocument.Shapes
            If shpTemp.Type = msoGroup Then
                shpTemp.Ungroup
                bDone = False
            End If
        Next shpTemp
    Loop Until bDone

    'Get count in main document
    Selection.HomeKey Unit:=wdStory
    Set wcTemp = Dialogs(wdDialogToolsWordCount)
    wcTemp.Update
    wcTemp.Execute
    lngDocWords = wcTemp.Words
    lngDocChars = wcTemp.Characters

    'Step through shapes and add counts
    lngTBWords = 0
    lngTBChars = 0
    For Each shpTemp In ActiveDocument.Shapes
        shpTemp.Select
        wcTemp.Execute
        lngTBWords = lngTBWords + wcTemp.Words
        lngTBChars = lngTBChars + wcTemp.Characters
    Next shpTemp
    lngDocWords = lngDocWords + lngTBWords
    lngDocChars = lngDocChars + lngTBChars

    Application.ScreenUpdating = True
    MsgBox Str(ActiveDocument.Shapes.Count) _
      & " text boxes found with" & vbCr _
      & Str(lngTBWords) & " word(s) and" & vbCr _
      & Str(lngTBChars) & " characters" & vbCr & vbCr _
      & " In the total document there are" & vbCr _
      & Str(lngDocWords) & " word(s) and" & vbCr _
      & Str(lngDocChars) & " characters"
End Sub

Remember that this macro ungroups any grouping previously done in the document. For this reason, you may want to run the macro after saving your document, and then discard the document (reload it from disk) after getting your count.