如何把5句话中红词替换成长度相等的下划线

zzpsx

如何把5句话中红词替换成长度相等的下划线.rar (3.63 KB, 下载次数: 8)

2018-2-16 10:08 上传

点击文件名下载附件

hhjjpp

表面上非vba不可，因为word默认是将连续字符一次性查找到
查找-高级-格式-选字体-红色和下划线
特殊格式选单个字母
将对应每个字母都替换为空格即可

13907933959

Sub 把红词替换成长度相等的下划线()

    With ActiveDocument.Content.Find

        .Font.Color = wdColorRed

        .Execute "", , , 1, , , , , ,"       ", 2

    End With

EndSub

zzpsx

13907933959 发表于 2018-2-16 11:40
Sub 把红词替换成长度相等的下划线()    With ActiveDocument.Content.Find        .Font.Underline = wdUn ...

谢谢。很好的代码。

zzpsx

不好意思，一开始我顺序表达错误，再发一贴，劳烦各位高手指点，谢谢 如何这5个单词提取出来，放在第一句上面，单词间两个空格。.rar (3.83 KB, 下载次数: 8)

2018-2-16 12:20 上传

点击文件名下载附件

413191246se

楼主 过年好！春节好！ 徒弟 139 过年好！春节好！
请将附件中《分割线》一段及以下段落删除后测试！（提取出来的单词有下划线，楼主自己取消即可）

1. Sub test()
   
2. 'code by duquancai,413191246se略改
   
3.     On Error Resume Next
   
4.     Dim i&
   
5.     Selection.HomeKey unit:=wdStory
   
6.     Selection.TypeParagraph
   
7.     With ActiveDocument.Content.Find
   
8.         .Font.Underline = wdUnderlineSingle
   
9.         .Font.Color = wdColorRed
   
10.         Do While .Execute
    
11.             i = i + 1
    
12.             .Parent.Copy
    
13.             With Selection
    
14.                 .HomeKey unit:=wdStory
    
15.                 .EndKey unit:=wdLine
    
16.                 .Paste
    
17.                 .TypeText Text:="  "
    
18.             End With
    
19.             .Parent.Text = Space(7)
    
20.             .Parent.Select
    
21.             Selection.Collapse 0
    
22.         Loop
    
23.     End With
    
24.     MsgBox "处理完毕！共替换 " & i & " 处下划线！请核对！", 0 + 48
    
25. End Sub

复制代码

zzpsx

413191246se 发表于 2018-2-16 16:03
楼主 过年好！春节好！ 徒弟 139 过年好！春节好！
请将附件中《分割线》一段及以下段落删除后测试！（提 ...

谢谢神代码，新年快乐。

leikaiyi123

提取http://club.excelhome.net/forum.php?mod=viewthread&tid=1397632&extra=page%3D1&mobile=2
4楼

tangqingfu

谢谢分享，学习ing……

leikaiyi123

替换成等长的下划线并不好，除非足够长，建议根据单词的长度确定下划线空格的长度，比原单词略长一点，因手写比印刷体大些。
.Parent.Text = Space(len(.Parent.Text)+2)