vba - 如何优化和改进 MS Word 的图表宏？

Question

此宏在文档中的表格中搜索 4 个单词的所有实例。我通过引用“ActiveDocument.Tables(3) 也称为文档中的第三个表”来限制范围。

我想知道：
（1）是否有更简单的方法来编写我的 4 个 while 循环，让它们查看并记录一个单词的 4 个单独实例的值。
（2）如果有语法方式限制文档中第三个表的第三列的代码范围。

我有while循环的原因是将4个不同单词的4个不同值记录到Excel文档中用于图表原因http://msdn.microsoft.com/en-us/library/ff629397.aspx

到目前为止，这是我的代码：

Sub CreateChartFromExistingTable()

    Dim salesChart As Chart
    Dim chartWorkSheet As Excel.Worksheet
    Dim iCount As Integer
    Dim range As range
    Dim List
    Dim jCount As Integer
    Dim range1 As range
    Dim kCount As Integer
    Dim range2 As range
    Dim lCount As Integer
    Dim range3 As range


    Set salesChart = ActiveDocument.Shapes.AddChart.Chart
    Set chartWorkSheet = salesChart.ChartData.Workbook.Worksheets(1)

    Set range = ActiveDocument.Tables(3).range
    Set range1 = ActiveDocument.Tables(3).range
    Set range2 = ActiveDocument.Tables(3).range
    Set range3 = ActiveDocument.Tables(3).range
    iCount = 0

    With range.Find
    .Text = "Passed"
    .Format = True
    .MatchCase = True
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False

        Do While .Execute(Forward:=True) = True
            iCount = iCount + 1
        Loop

    End With

    jCount = 0
    With range1.Find
    .Text = "Failed"
    .Format = True
    .MatchCase = True
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False

        Do While .Execute(Forward:=True) = True
            jCount = jCount + 1
        Loop

    End With
    kCount = 0
    With range2.Find
    .Text = "No Run"
    .Format = True
    .MatchCase = True
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False

        Do While .Execute(Forward:=True) = True
            kCount = kCount + 1
        Loop

    End With
    lCount = 0
    With range3.Find
    .Text = "N/A"
    .Format = True
    .MatchCase = True
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False

        Do While .Execute(Forward:=True) = True
            lCount = lCount + 1
        Loop

    End With

    chartWorkSheet.ListObjects("Table1").Resize chartWorkSheet.range("A1:B5")
    chartWorkSheet.range("Table1[[#Headers],[Series 1]]").FormulaR1C1 = "Test Instances Summary Graph"

    chartWorkSheet.range("A2").FormulaR1C1 = "Passed"
    chartWorkSheet.range("A3").FormulaR1C1 = "Failed"
    chartWorkSheet.range("A4").FormulaR1C1 = "No Run"
    chartWorkSheet.range("A5").FormulaR1C1 = "N/A"
    chartWorkSheet.range("B2").FormulaR1C1 = iCount
    chartWorkSheet.range("B3").FormulaR1C1 = jCount
    chartWorkSheet.range("B4").FormulaR1C1 = kCount
    chartWorkSheet.range("B5").FormulaR1C1 = lCount

    salesChart.ChartType = xlPie
    salesChart.ChartData.Workbook.Application.Quit

End Sub

请确保您在 MS Word 的 VB 编辑器中引用了 Microsoft Excel 14.0 对象库。

Answer 1

我认为这就是您正在寻找的：

Dim Range As Range
Dim maxCases, curCase, iCount, jCount, kCount, lCount As Integer
Dim texts(5) As String

texts(1) = "Passed"
texts(2) = "Failed"
texts(3) = "No Run"
texts(4) = "N/A"

maxCases = 4
curCase = 0
Do
    curCase = curCase + 1
    curCount = 0

    ActiveDocument.Tables(3).Range.Columns(3).Select
    Set Range = Selection.Range
    With Range.Find
        .Text = texts(curCase)
        .Format = True
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False

        Do While .Execute(Forward:=True) = True
            curCount = curCount + 1
        Loop

        If (curCase = 1) Then
            iCount = curCount
        ElseIf (curCase = 2) Then
            jCount = curCount
        ElseIf (curCase = 3) Then
            kCount = curCount
        ElseIf (curCase = 4) Then
            lCount = curCount
        End If

    End With

Loop While (curCase < maxCases)

我已经对其进行了测试，并且该 Set Range =部分必须在循环内；否则它将仅适用于第一次迭代。