[英]Word VBA: Macro to change cells in selection, and create a summary table of the tables?
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. 编辑:结果列Instances
已更改为“实例数”,而不是显示原始值。
Here's a solution based on the comments. 这是基于评论的解决方案。 It's just based on reading your code without testing so hopefully this works. 它只是基于读取代码而不进行测试的,因此希望它可以工作。 If it needs some tweaks, please feel free to edit. 如果需要一些调整,请随时进行编辑。
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
Table of Tables (with info): 表格表(带信息):
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.