Sub TextBoxCount()
Dim lngTBWords As Long ' 文本框的字数
Dim lngTBChars As Long ' 文本框的字符总数
Dim lngDocWords As Long ' 整个文档的字数
Dim lngDocChars As Long ' 整个文档的字符总数
'Shape代表一个图形层对象,例如自选图形(包含文本框)、
'任意多边形、OLE 对象、ActiveX 控件、图片等。Shape 对
'象是 Shapes 集合的一个成员,该集合包含了一篇文档正文
'部分的所有图形。
'为简单计,下文仍把Shape称为文本框,因为它是这里要处理
'的“主角”
Dim shpTemp As Shape
Dim wcTemp As Dialog '对话框
Dim bDone As Boolean

'关闭屏幕更新,以提高统计速度
Application.ScreenUpdating = False

'扫描整个文档,如果发现定义成组的文本框
'则拆分组。
'这里之所以要加上一个Do...Loop循环,是因为一旦拆分了定义成
'组的文本框,文档的文本框总数会发生变化。所以我们要加上一个
'Do...Loop循环多次扫描文档,直至最后一次扫描找不到定义成组
'的文本框为止。
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

'统计文档主体的字数
Selection.HomeKey Unit:=wdStory
'将wcTemp设置为“字数统计”对话框
Set wcTemp = Dialogs(wdDialogToolsWordCount)
'执行“字数统计”对话框的功能
wcTemp.Update
wcTemp.Execute
'获得文档主体的字数和字符数
lngDocWords = wcTemp.Words
lngDocChars = wcTemp.Characters

'依次访问每一个文本框,统计字数
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 "文本框(Shape对象)总数:" & Str(ActiveDocument.Shapes.Count) & vbCr _
& "文本框的字数总计:" & Str(lngTBWords) & vbCr _
& "文本框的字符数总计:" & Str(lngTBChars) & vbCr & vbCr _
& "整个文档的字数总计:" & Str(lngDocWords) & vbCr _
& "整个文档的字符数总计:" & Str(lngDocChars)
End Sub