單詞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

我們需要考慮以下幾個方面針對宏用作期望：

• A按鈕或其他物體可以」用於調用宏，因爲這將有效地改變選擇。相反，它可以運行Alt + F8或分配給宏的快捷鍵
• 選擇必須是連續的。所以，如果有4個表格，選擇表格＃1，& 3將不起作用。它應該像表＃1到3.

有了這個和一些小的調整，下面轉載的修改後的代碼應該工作。

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

編輯：結果爲Instances列已更改爲「實例數」，而不是顯示原始值。

Answer 2

下面是基於評論的解決方案。這只是基於閱讀你的代碼而不進行測試，所以希望這可以工作。如果需要一些調整，請隨時編輯。

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) 
      myCell.Range.Text = "Thing #" & t 
      Next t 
     End With 
End Sub 

表表（具有信息）的：

Sub TableOfThings() 
    Dim t As Integer 
    Dim tbl as Table 
    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" 

    t = 1 
    For each tbl in myRange.Tables 
     With tbl 
      Set Title = .Cell(1,2).Range 
      Set Instances = .Cell(2,2).Range 
      Set Score = .Cell(3,2).Range 
     End With 

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

End Sub