如何提取word中指定颜色（如红色）的文本到新建的文档

丶冫氵灬

本人在作试卷答案时遇到了一个难题，就是想把红色答案与题（颜色为黑色）分开，但是用查找的方法很慢，哪位大侠能不能写一个VBA，帮忙做一下。

413191246se

1. Sub Red_To_White()
   
2.     With ActiveDocument.Content.Find
   
3.         .ClearFormatting
   
4.         .Font.ColorIndex = wdRed
   
5.         With .Replacement
   
6.             .ClearFormatting
   
7.             .Font.ColorIndex = wdWhite
   
8.         End With
   
9.         .Execute Findtext:="", ReplaceWith:="", Format:=True, Replace:=wdReplaceAll
   
10.     End With
    
11. End Sub

复制代码

丶冫氵灬

413191246se 发表于 2021-11-25 02:14

这个方法是把红色答案字体变成与背景色一样的颜色，从而达到隐藏的目的，谢谢你给我提供了一种思路。但我想把红色答案文本提取出来放在试题的最后，这红色字体文本怎么通过VBA提取出来，并放在试题的后边或放在另一个新建的文档里面？（我手工也会）

413191246se

楼主，能否提供一个具体附件以方便处理（因为答案要与题号联系，不能只提取答案而无题号）。

413191246se

1. Sub a_get_red()
   
2.     Dim s$, t$
   
3.     With ActiveDocument.Content.Find
   
4.         .ClearFormatting
   
5.         .Text = ""
   
6.         .Font.ColorIndex = wdRed
   
7.         .Forward = True
   
8.         .MatchWildcards = True
   
9.         Do While .Execute
   
10.             With .Parent
    
11.                 s = .Text
    
12.                 t = t & s
    
13.                 .Delete
    
14.             End With
    
15.         Loop
    
16.     End With
    
17.     ActiveDocument.Content.InsertAfter Text:=vbCr & vbCr & "*****************" & vbCr & t
    
18. End Sub

复制代码

蜀中草莽

求提取试题库答案，如何提取颜色为红色的答案
https://club.excelhome.net/thread-1396523-1-1.html
(出处: ExcelHome技术论坛)

丶冫氵灬

413191246se 发表于 2022-7-5 12:14

这里的提取是把原来的文本剪切掉了，如果是不剪切原来的文本，是不是把“delete”改为“copy”？

413191246se

Yes, you're right!