Program Word VBA: Makro do zmiany zaznaczonych komórek i utworzenia tabeli podsumowań tabel?

Question

Mam kilka tabel w dokumencie, które wyglądają mniej więcej tak:

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

Figure 1 
<Screenshot of Proof> 

chciałbym, aby wyglądał jak ten (numer w lewym górnym rogu komórki):

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

Ale w dokumencie jest wiele tabel i chciałbym tylko użyć tych "w ramach selekcji".

W skrócie: Muszę wziąć wszystkie tabele w ramach selekcji i numerować je kolejno. Chciałbym również, aby stół z tych tabel, które wygląda następująco:

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

Oto co mam do tej pory:

numeracja tabelach:

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 

Spis tabel (z informacją):

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 

Ale nie działają tak, jak chcę, i Wydaje mi się, że nie mogę ich zmusić do pracy.

Czy ktoś może zapewnić mi rozwiązanie?

Answer 1

Trzeba uwzględnić następujące aspekty dla makro funkcjonować jako pożądany:

• przycisk lub inny przedmiot może” t należy użyć do wywołania makra, ponieważ to skutecznie zmieni wybór. Zamiast tego może być uruchamiany przez Alt + F8 lub klawisz skrótu przypisany do makra
• Wybór musi być ciągły. Tak więc, jeśli istnieją 4 tabele, wybór tylko tabeli # 1, & 3 nie będzie działać. Powinien raczej wyglądać jak w tabeli nr 1 do 3.

Przy pomocy tego i kilku drobnych poprawek, zmodyfikowany kod, jak przedstawiono poniżej, powinien działać.

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 

Edit: wynik na kolumnie Instances została zmieniona na „liczbę wystąpień”, zamiast wyświetlania oryginalne wartości.

Answer 2

Oto rozwiązanie oparte na komentarzach. To po prostu opiera się na czytaniu twojego kodu bez testowania, więc mam nadzieję, że to działa. Jeśli wymaga pewnych poprawek, możesz edytować.

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 

Tabela tabelach (z informacją)

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