怎么根据表格中某个单元的值在其位置上添加直线

0Pluto · 发表于 2022-6-13 16:25

各位好，我有一个需求，我先大致描述一下吧。

有很多个文档，其中每一个文档中，每一页都是一个表格。我想在表格中 “单位（子单位）”上单位的位置添加一个斜线，同理，如果碰到“分部（子分部）”，也在分部上面添加一个斜线。最终实现的效果在我上传的文档里面。

【由于文档中表的标题可能会在上一页，所以如果添加形状的坐标是固定的话，会偏移，不知道这里能不能获取某个单元格的x，y坐标？】

我试了很久，功能整合是出的问题一直没能解决。首先把功能一个个拆解。1. 先实现了添加斜线的功能。这个我是直接弄的相对位置。2. 判断表格第二行第一列里面的文字是否和预设文字匹配，是则执行画斜线。3. 遍历每一个表格。4. 遍历每一个文档。

下面是画斜线的代码。我当初试的时候，挺正常的，可惜需要将光标点在某一页，才会在这一页上执行。

Sub NewCanvasLine()
Dim shpCanvas As Shape
Dim shpLine As Shape
Set shpCanvas = ActiveDocument.Shapes _
.AddCanvas(Left:=90, Top:=125, _
Width:=150, Height:=150)
'Add a line to the drawing canvas
Set shpLine = shpCanvas.CanvasItems.AddLine( _
BeginX:=5, BeginY:=5, EndX:=25, EndY:=14)
'Add an arrow to the line and sets the color to purple
With shpLine.Line
.Weight = 1
.ForeColor.RGB = RGB(Red:=0, Green:=0, Blue:=0)
End With
End Sub

复制代码

下面是整合了遍历所有表格，然后判断才画线的代码。最终的运行效果就是，添加的线都重复画到了第一页，但是数量是对的。

Sub 斜线1()
'
' 斜线1 宏
'
'
Dim shpCanvas As Shape
Dim shpLine As Shape
Dim mystr As String
Dim mystr1 As String
Dim oCell As Cell
Dim cellText As String
mystr = "单位（子单位"
mystr1 = "单位(子单位"
For i = 1 To ActiveDocument.Tables.Count
Set oCell = ActiveDocument.Tables(i).Cell(2, 1) '选择整个单元格内容
cellText = Mid(oCell.Range.Text, 1, 6)
If StrComp(cellText, mystr, 1) = 0 Then
Set shpCanvas = ActiveDocument.Shapes _
.AddCanvas(Left:=90, Top:=125, _
Width:=150, Height:=150)
'Add a line to the drawing canvas
Set shpLine = shpCanvas.CanvasItems.AddLine( _
BeginX:=5, BeginY:=5, EndX:=25, EndY:=14)
'Add an arrow to the line and sets the color to purple
With shpLine.Line
.Weight = 1
.ForeColor.RGB = RGB(Red:=0, Green:=0, Blue:=0)
End With
End If
Next i
End Sub

复制代码

整个问题的难点在于：
1. 如何找到文档中某个单元格的位置，这需要用来设置画布的位置，不然后面会有偏差
2. 为什么我上面整合的代码只会在第一页上添加呢？（其实我想过在画布位置的地方加上每一页的偏移量，但是找不到这个数值）

叙述比较多，能看完的兄弟能不能指教一下，谢谢！

psxk3535028-1 · 发表于 2022-6-19 06:27

Active，当前的、激活的、活跃的，当然只在这一页操作了，如果要在指定页操作，就应该换成指定页

		自动登录	找回密码
密码			注册