VBA实用小程序78：统计工作簿内文本框和批注中的字符及单词数

Sub CountCharWorBOXCMT()
    Dim wks As Worksheet
    Dim lCommentch As Long
    Dim lCommentwords As Long
    Dim lTxtBoxChar As Long
    Dim lTxtBoxCharWords As Long
    Dim objShp As Shape
    Dim sMsg As String
    Dim vbaArray
    Application.ScreenUpdating = False
    lCommentch = 0
    lCommentwords = 0
    lTxtBoxChar = 0
    lTxtBoxCharWords = 0
    For Each wks In ActiveWorkbook.Worksheets
        For Each objShp In wks.Shapes
            ' 统计文本框中的字符和单词
            If objShp.Type = 17 Then
                IfLen(objShp.TextFrame2.TextRange.Characters.Text) <> 0 Then
                    lTxtBoxChar = lTxtBoxChar +objShp.TextFrame.Characters.Count
                    vbaArray =VBA.Split(objShp.TextFrame2.TextRange.Characters.Text, " ")
                    lTxtBoxCharWords =lTxtBoxCharWords + UBound(vbaArray) + 1
                End If
            End If
            ' 统计批注中的字符和单词
            If objShp.Type = 4 Then
                With objShp.TextFrame.Characters
                    lCommentch = lCommentch +Len(.Text)
                    vbaArray = VBA.Split(.Text," ")
                    lCommentwords =lCommentwords + UBound(vbaArray) + 1
                End With
            End If
        Next objShp
    Next wks
    sMsg = "文本框中的字符数: " & Format(lTxtBoxChar,"### ### ##0") & vbCrLf
    sMsg = sMsg & "文本框中的单词数: " &Format(lTxtBoxCharWords, "### ### ##0") & vbCrLf & vbCrLf
    sMsg = sMsg & "批注中的字符数: " &Format(lCommentch, "### ### ##0") & vbCrLf
    sMsg = sMsg & "批注中的单词数: " &Format(lCommentwords, "### ### ##0") & vbCrLf & vbCrLf
    MsgBox Prompt:=sMsg, Title:="统计汇总"
    Application.ScreenUpdating = True
End Sub