I have a bunch of tables in a document that look roughly like this:
| Thing | Title |
|-----------|:---------:|
| Info | A, B, C. |
| Score | Foo |
| More Info | Long Text |
| Proof | Blah |
Figure 1
<Screenshot of Proof>
I'd like to make it look like this (Number in the upper left cell):
| Thing #1 | Title |
|-----------|:-----------------:|
| Info | A, B, C. |
| Score | Foo |
| More Info | Long Text |
| Proof | Blah <Screenshot> |
But, the there are many tables in the document, and I'd only like to use the ones "within selection".
In short: I have to take all tables within a selection and number them sequentially. I'd also like to make a table of these tables that looks like this:
| Number | Title | Score | Number of CSV's in Info |
|--------|:-----:|-------|-------------------------|
| 1 | Thing | Foo | 3 |
| ... | ... | ... | ... |
| ... | ... | ... | ... |
| ... | ... | ... | ... |
Here is what I have so far:
Numbering Tables:
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
Table of Tables (with info):
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
But they flat out don't work the way I want them to, and I can't seem to manage to get them to work.
Could someone provide me with a solution?
We need to consider the following aspects for the macro to function as desired:
With that and a few minor tweaks, the modified code as reproduced below should work.
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: the result for column Instances
has been changed to "number of instances", rather than displaying the original values.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With