從 Excel VBA 中的 TextBox 計算單詞

Question

我有計算 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

如何從文本框中計算單詞？

我找不到任何類似的 TextFrame 屬性。 TextFrame2 不起作用。

Answer 1

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

說明：

Split() 函數返回在您指定的分隔符上拆分的字符串數組。 例如， split("Carl is awesome"," ") 將拆分為 " "（一個空格）並返回：["Carl", "is", "awesome"]。 該數組的索引為 0-2。

Ubound() 返回數組中最后一個元素的索引。 由於 split() 中的數組從 0 開始，我們需要將 1 添加到 ubound() 的結果中。

函數 CountWords() 接受一個字符串並返回空格數+1，這幾乎可以肯定是單詞數。 您可能會考慮檢查 split() 返回的元素的長度以捕獲長度為 0 的“單詞”，即雙空格或前導或尾隨空格。

Answer 2

給你

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

感謝大衛。 他給了我正確的靈感。 代碼終於找到了。 謝謝我和大衛。 現在我也可以與他人分享：

    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

如果單詞是由空格分隔的字符串，那么您可以計算任何字符串中的單詞，例如：

Sub WordCount()
    Dim s As String

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

這里Trim()用於刪除任何多余的空格

編輯#1：

這是我將它應用於 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

這是我如何計算該文本框中的單詞：

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

嘗試使用以下代碼

已測試

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

很棒的代碼！ 是否可以在 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