用VBA可以实现提取高亮的表格行放到word吗？

晨晓之黎 · 发表于 2021-7-2 08:24

像这种，只提取高亮青绿的行放到word里，页数上千太多，手动删除没有高亮的行很耗时！求vba代码！谢谢！

413191246se · 发表于 2021-7-4 02:51

Sub aaaa_Get_Highlight_Rows()
Dim t As Table, r As Row
With ActiveDocument
For Each t In .Tables
For Each r In t.Rows
With r
If Not .Cells(1).Range.HighlightColorIndex = wdTurquoise Then .Delete
End With
Next
Next
.Range(Start:=0, End:=.Tables(1).Range.Start).Delete
.Tables(1).Select
Selection.SplitTable
'display symbol/^12
For Each t In .Tables
t.Range.Characters(1).Previous.InsertParagraphBefore
Next
'delete symbol/^12
With Selection
.HomeKey 6
With .Find
.ClearFormatting
.Text = "^13^12"
.Replacement.Text = ""
.Forward = True
.MatchWildcards = True
Do While .Execute
With .Parent
.Delete
End With
Loop
End With
End With
'display symbol/^12
For Each t In .Tables
t.Range.Characters(1).Previous.InsertParagraphBefore
Next
'delete symbol/^12
With Selection
.HomeKey 6
With .Find
.ClearFormatting
.Text = "^13^12"
.Replacement.Text = ""
.Forward = True
.MatchWildcards = True
Do While .Execute
With .Parent
.Delete
End With
Loop
End With
End With
.Tables(1).Range.HighlightColorIndex = wdNoHighlight
.Range(Start:=0, End:=.Tables(1).Range.Start).Delete
Selection.HomeKey 6
If .Tables.Count = 1 Then MsgBox "Not-Saved! Total records is " & .Tables(1).Rows.Count & " lines!", 0 + 16 Else MsgBox "More-Tables!", 0 + 16
End With
End Sub

复制代码

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

[求助] 用VBA可以实现提取高亮的表格行放到word吗？