从 Excel VBA 中的 TextBox 计算单词

Question

I have code that counts characters in a TextBox.

Sub CountCharFromTextBox()
    Dim shp As Shape
    Dim wks As Worksheet
    Dim lTxtBoxWords As Long
    For Each wks In ActiveWorkbook.Worksheets
        For Each shp In wks.Shapes
            If TypeName(shp) <> "GroupObject" Then
                lTxtBoxWords = shp.TextFrame.Characters.Count
            End If
        Next shp
    Next wks
    MsgBox lTxtBoxWords
End Sub

How can I count words from Textboxes?

I can't find any similar Property for TextFrame. TextFrame2 doesnt work.

Answer 1

Function countWords(ByVal sentence As String) As Integer
    countWords = UBound(Split(sentence, " ")) + 1
End Function

Explanation:

The Split() function returns an array of strings split on a delimiter you specify. For example, split("Carl is awesome"," ") would split on " " (a space) and return: ["Carl", "is", "awesome"]. The indices of this array are 0-2.

Ubound() returns the index of the last element in an array. Since arrays from split() start at 0, we need to add 1 to the result of ubound().

The function CountWords() takes a string and returns the number of spaces+1, which is almost certainly the number of words. You might consider checking the length of elements returned by split() to catch 0-length "words", ie double spaces or leading or trailing spaces.

Answer 2

Here you go

Sub CountCharFromTextBoxV2()
    For Each shp In ActiveSheet.Shapes
        ActiveSheet.Shapes.Range(Array(shp.Name)).Select
        theString = Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text
        theNumWords = Len(Trim(theString)) - Len(Replace(Trim(theString), " ", "")) + 1
        MsgBox "TextBox Name: " & shp.Name & vbNewLine & vbNewLine & "Number of words: " & theNumWords
    Next
End Sub

Answer 3

Thanks to David. He gave me the right inspiration. The code is finally found. Thanks for me and David. Now I can share with others too:

    Sub CountWordsFromTextBox()

        Dim shp As Shape
        Dim wks As Worksheet
        Dim lTxtBoxWords As String
        theNumWords = 0
            For Each wks In ActiveWorkbook.Worksheets
                For Each shp In wks.Shapes
                    If TypeName(shp) <> "GroupObject" And shp.TextFrame2.TextRange.Characters.Text <> "" Then
                        lTxtBoxWords = shp.TextFrame2.TextRange.Characters.Text
                        theNumWords = theNumWords + Len(Trim(lTxtBoxWords)) - Len(Replace(Trim(lTxtBoxWords), " ", "")) + 1
                    End If
                Next shp
                Next wks
                MsgBox theNumWords
        End Sub

Answer 4

If words are character strings separated by a space, then you can count words in any string like:

Sub WordCount()
    Dim s As String

    s = "klaatu barada nikto"
    With Application.WorksheetFunction
        MsgBox UBound(Split(.Trim(s), " ")) + 1
    End With
End Sub

Here Trim() is used to remove any extraneous spaces

EDIT#1:

Here is how I would apply this to a TextBox. First create the TextBox:

Sub BoxMaker()
    ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 217.5, 51#, _
        482.25, 278.25).Select
    Selection.Name = "SPLASH"
    Selection.Characters.Text = "Please Wait for Macro"
    With Selection.Characters(Start:=1, Length:=21).Font
        .Name = "Arial"
        .FontStyle = "Regular"
        .Size = 36
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Selection.HorizontalAlignment = xlCenter
    Selection.VerticalAlignment = xlCenter
End Sub

and here is how I would count the words in that TextBox:

Sub WordCounter2()
    Dim s As String
    ActiveSheet.Shapes("SPLASH").Select
    s = Selection.Characters.Text
    With Application.WorksheetFunction
        MsgBox UBound(Split(.Trim(s), " ")) + 1
    End With
End Sub

Answer 5

Try with below code

Tested

Sub CountCharFromTextBox()
    Dim shp As Shape
    Dim wks As Worksheet
    Dim lTxtBoxWords As Long
    Dim lTxtBoxWordsnew As Long
        For Each wks In ActiveWorkbook.Worksheets
            For Each shp In wks.Shapes
                If TypeName(shp) <> "GroupObject" Then
                    lTxtBoxWords = shp.TextFrame.Characters.Count
                    lTxtBoxWordsnew = getwordscount(shp.TextFrame.Characters.text)
                End If
            Next shp
        Next wks
        MsgBox lTxtBoxWordsnew
End Sub


Private Function getwordscount(text As String)
    getwordscount = Len(text) - Len(Application.WorksheetFunction.Substitute(text, " ", "")) + 1
End Function

Answer 6

Great code! Is it possible to use this in PowerPoint?

Sub CountWordsFromTextBox()
    Dim shp As Shape
    Dim wks As Worksheet
    Dim lTxtBoxWords As String
    theNumWords = 0
        For Each wks In ActiveWorkbook.Worksheets
            For Each shp In wks.Shapes
                If TypeName(shp) <> "GroupObject" And shp.TextFrame2.TextRange.Characters.Text <> "" Then
                    lTxtBoxWords = shp.TextFrame2.TextRange.Characters.Text
                    theNumWords = theNumWords + Len(Trim(lTxtBoxWords)) - Len(Replace(Trim(lTxtBoxWords), " ", "")) + 1
                End If
            Next shp
            Next wks
            MsgBox theNumWords
    End Sub