Word VBA:宏来更改选择中的单元格,并创建表格的汇总表？

Question

我在文档中有一堆看起来像这样的表:

| Thing     |   Title   |
|-----------|:---------:|
| Info      | A, B, C.  |
| Score     | Foo       |
| More Info | Long Text |
| Proof     | Blah      |

Figure 1
<Screenshot of Proof>

我想让它看起来像这样(左上角的单元格中的数字):

| Thing #1  |       Title       |
|-----------|:-----------------:|
| Info      | A, B, C.          |
| Score     | Foo               |
| More Info | Long Text         |
| Proof     | Blah <Screenshot> |

但是,文档中有许多表格,我只想使用"在选择范围内".

简而言之:我必须选择所有表格并按顺序编号.我还想制作一个这样的表格,如下所示:

| Number | Title | Score | Number of CSV's in Info |
|--------|:-----:|-------|-------------------------|
| 1      | Thing | Foo   | 3                       |
| ...    | ...   | ...   | ...                     |
| ...    | ...   | ...   | ...                     |
| ...    | ...   | ...   | ...                     |    

这是我到目前为止:

编号表:

Sub NumberTablesSelection()
    Dim t As Integer

    Dim myRange as Range
    Set myRange = Selection.Range

    With myRange
        For t = 1 To .Tables.Count
            Set myCell = .Tables(t).Cell(1,1).Range
            myCell.Text = "Thing #" + t
            Next t
        End With
End Sub

表格(有信息):

Sub TableOfThings()
    Dim t As Integer

    Dim myRange as Range
    Set myRange = Selection.Range

    myTable = Tables.Add(Range:=tableLocation, NumRows:=1, NumColumns:=4)
    myTable.Cell(1,1).Range.Text = "Number"
    myTable.Cell(1,2).Range.Text = "Title"
    myTable.Cell(1,3).Range.Text = "Score"
    myTable.Cell(1,4).Range.Text = "Instances"

    With myRange
        For t = 1 To .Tables.Count

            Set Title = .Tables(t).Cell(1,2).Range 
            Set Instances = .Tables(t).Cell(2,2).Range
            Set Score = .Tables(t).Cell(3,2).Range

            Set NewRow = myTable.Rows.Add
            NewRow.Cells(1).Range.Text = t
            NewRow.Cells(2).Range.Text = Title
            NewRow.Cells(3).Range.Text = Score
            NewRow.Cells(4).Range.Text = Instances
        End With
End Sub

但他们没有按照我希望他们的方式工作,我似乎无法让他们工作.

有人能为我提供解决方案吗？

Answer 1

我们需要考虑以下几个方面让宏按需运行:

• 按钮或其他对象不能用于调用宏,因为它将有效地更改选择.相反,它可以由Alt + F8分配给宏的任一或快捷键运行
• 选择必须是连续的.因此,如果有4个表,则仅选择表#1和3将不起作用.它应该像表#1到3.

通过这一点和一些小调整,下面复制的修改后的代码应该可行.

Option Explicit\nSub NumberTablesSelection()\n    Dim t As Integer, myRange, myCell As Range\n    Set myRange = Selection.Range\n    With myRange\n        For t = 1 To .Tables.Count\n            Set myCell = .Tables(t).Cell(1, 1).Range\n            myCell.Text = "Thing #" & t\n        Next t\n    End With\nEnd Sub\nSub TableOfThings()\n    Dim t As Integer, myRange As Range, myTable As Table, NewRow As Row, Title As String, Instances As Integer, Score As String\n    Set myRange = Selection.Range\n    Selection.EndKey Unit:=wdStory\n    Set myTable = ActiveDocument.Tables.Add(Range:=Selection.Range, NumRows:=1, NumColumns:=4)\n    With myTable\n        .Style = "Table Grid"\n        .Rows(1).Shading.BackgroundPatternColor = -603917569\n        .Cell(1, 1).Range.Text = "Number"\n        .Cell(1, 2).Range.Text = "Title"\n        .Cell(1, 3).Range.Text = "Score"\n        .Cell(1, 4).Range.Text = "Instances"\n    End With\n    With myRange\n        For t = 1 To .Tables.Count\n            Title = .Tables(t).Cell(1, 2).Range\n            Instances = UBound(Split(.Tables(t).Cell(2, 2).Range, ",")) + 1\n            Score = .Tables(t).Cell(3, 2).Range\n            Set NewRow = myTable.Rows.Add\n            With NewRow\n                .Shading.BackgroundPatternColor = wdColorAutomatic\n                .Cells(1).Range.Text = t\n                .Cells(2).Range.Text = txtClean(Title)\n                .Cells(3).Range.Text = txtClean(Score)\n                .Cells(4).Range.Text = Instances\n            End With\n        Next t\n    End With\nEnd Sub\nFunction txtClean(txt As String) As String\n    txt = Replace(txt, Chr(7), "")\n    txt = Replace(txt, Chr(13), "")\n    txt = Replace(txt, Chr(11), "")\n    txtClean = txt\nEnd Function\n

编辑:列的结果Instances已更改为"实例数",而不是显示原始值.