如何用vba批量定位word中的表格，以及替换表格内容为域

有时发晕 · 发表于 2016-12-6 12:28

请高手解惑！！！因为工作需要，需要将网上的数学试题录入word文档，在网页版中分数形式都是用表格排版的，在word中就不行了。例如网页中的是这样的

在复制粘贴到word上的效果世这样的

我想要的结果是在原来分数位置（1×2）表格（table），并将原来的多余换行符、表示分数的表格去掉，替换成域代码

切换代码后就变成了这个形式

注：需要替换的表格有两种形式：1、除了上图中的选择题选项是1×4的表格中每个cell再嵌套一个2×1的表示分数的表格；2、选择题或其它题型题干中的分数都是2×1的表格

现在已有的思路是，1、定位含有分数的表格位置；
                              2、读取分子、分母的值（不知道这个值在word中的是什么类型）；
                              3、域代码{eq \f(m,n)}，将分子赋值给m，分母赋值给n，切换域
                              4、删除表格，多余的换行符

我试着写了找1×2的表格分数并替换好像就有问题，高手见笑了！

网页试题处理工具.rar (7.07 KB, 下载次数: 30)
Sub find_table()
'
' find_table 宏
'
'
Dim m, n As String
For i = 1 To 2
If ActiveDocument.Tables(i).Rows.Count = 2 And ActiveDocument.Tables(i).Columns.Count = 1 Then
m = ActiveDocument.Tables(i).Cell(1, 1).Range.Text
n = ActiveDocument.Tables(i).Cell(1, 2).Range.Text
ActiveDocument.Tables(i).Select
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
PreserveFormatting:=False
Selection.TypeText Text:="eq \f(" & m & "," & n & ")"
Selection.Fields.ToggleShowCodes
Selection.TypeBackspace
End If
Next
End Sub

duquancai · 发表于 2016-12-6 12:39

不难，得花时间。

有时发晕 · 发表于 2016-12-6 13:04

@duquancai 我是花了时间也搞不出来
请问有Word vba 的教程么？
我只懂简单的Excel vba , word里面的完全不懂，比如不知道表格的属性方法，哪里有得查？

duquancai · 发表于 2016-12-6 14:04

有时发晕发表于 2016-12-6 13:04
@duquancai 我是花了时间也搞不出来
请问有Word vba 的教程么？
我只懂简单的Excel vba , word里面的完 ...

我就不信，明年这个时候你还搞不出来？

有时发晕 · 发表于 2016-12-6 15:14

duquancai 发表于 2016-12-6 14:04
我就不信，明年这个时候你还搞不出来？

这是帮我呢还是啥意思？

duquancai · 发表于 2016-12-6 15:15

有时发晕发表于 2016-12-6 15:14
这是帮我呢还是啥意思？

Sub shishi()
Dim tb As Table, tbl As Table, c As Cell, rng As Range
For Each tb In ActiveDocument.Tables
If tb.Tables.Count > 0 Then
For Each c In tb.Range.Cells
For Each tbl In c.Tables
m = Split(tbl.Range.Cells(1).Range, Chr(13) & Chr(7))(0)
n = Split(tbl.Range.Cells(2).Range, Chr(13) & Chr(7))(0)
tbl.Delete
c.Range = Replace(Split(c.Range, Chr(13) & Chr(7))(0), Chr(13), "")
With c.Range
.End = .End - 1: .Collapse 0
Set rng = ActiveDocument.Range(.Start, .End)
rng.Fields.Add rng, -1, "eq \f(" & m & "," & n & ")", 0
End With
Next
Next
End If
If tb.Rows.Count > 1 Then
With tb.Range
m = Split(.Cells(1).Range, Chr(13) & Chr(7))(0)
n = Split(.Cells(2).Range, Chr(13) & Chr(7))(0)
tb.Delete
Set rng = ActiveDocument.Range(.Start, .End)
rng.Fields.Add rng, -1, "eq \f(" & m & "," & n & ")", 0
End With
End If
Next
End Sub

复制代码

有时发晕 · 发表于 2016-12-6 23:23

有没有用我那个word,测试过呀，大侠！太牛了
有没有什么教程可以供学习一下的？

ammyc · 发表于 2016-12-20 21:41

好好学习天天向上

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