用VBA把下划线文字复制出来作为答案，并将下划线处理成填空

过客fppt

大家好，因为经常要把下划线文字复制出来作为答案，并将下划线处理成填空，所以想用VBA弄一个功能，要求如下：
1、如果选中前两个知识点，运行代码，则横线上的文字或者公式会被复制出来，并且在这选中区域下添加一行空白。填上答案并且把复制的知识点粘贴出来。
2、把刚才选中区域的横线处理成空的横线，并且横线的长度尽量跟原来知识点文字中的长度相同。
3、选中后面两个知识点，可以达到同样的效果
如下图所示：


目前在batmanbbs老师的指导下能做到将下划线的内容复制到选中段落的末端了。但是如何将下划线的内容填充成同样长度的空格，下划线还需要各位指引一下，谢谢

过客fppt

1. Sub 查找并选中所选范围内的下划线()
   
2.     Dim dw As Range
   
3.     Set dw = Selection.Range
   
4.     ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
   
5.     With dw.Find
   
6.         .Font.Underline = wdUnderlineSingle
   
7. 
   
8.         Do While .Execute = True
   
9.             dw.Editors.Add wdEditorEveryone
   
10.         Loop
    
11.     End With
    
12.     ActiveDocument.SelectAllEditableRanges wdEditorEveryone
    
13.     ActiveDocument.DeleteAllEditableRanges wdEditorEveryone
    
14. End Sub
    

复制代码

目前我想用上面这段代码，选中我所选的范围的下划线部分，但是运行后会选中文档中全部的下划线

batmanbbs

第9句前添加一句判断是否超过选区范围

过客fppt

batmanbbs 发表于 2023-8-10 19:20
第9句前添加一句判断是否超过选区范围

感谢batmanbbs老师，不过有点想不明白，为什么是判断我所选中区域的起始位置大于当前所选中的末位置呢？

按照我目的理解的话，如果加这一句判断，我觉得应该判断:当前选中区域的开始位置大于我所选中的末位置时，退出循环。

现在还没有电脑验证这个对不对，非常感谢！

batmanbbs

过客fppt 发表于 2023-8-10 21:25
感谢batmanbbs老师，不过有点想不明白，为什么是判断我所选中区域的起始位置大于当前所选中的末位置呢？
...

你可以用F8单步执行进行调试，能够看到在dw选区中搜索找到第一个目标的后，dw选区变化成第一个找到目标的范围了，再次查找时会变成从光标位置查找到文档结束位置，不再是原来SELECTION的范围了。

过客fppt

batmanbbs 发表于 2023-8-10 21:37
你可以用F8单步执行进行调试，能够看到在dw选区中搜索找到第一个目标的后，dw选区变化成第一个找到目标的 ...

原来如此，那我明天试一下。我本来以为设置了dw之后，只在这个范围内查找。谢谢啦！

batmanbbs

过客fppt 发表于 2023-8-10 21:58
原来如此，那我明天试一下。我本来以为设置了dw之后，只在这个范围内查找。谢谢啦！

除此之外，你还可以用SETRANGE重新设置查询区域（其实更推荐使用这个，但我曾经遇到过在表格中使用SETRANGE好像会有问题）

过客fppt

batmanbbs 发表于 2023-8-10 21:37
你可以用F8单步执行进行调试，能够看到在dw选区中搜索找到第一个目标的后，dw选区变化成第一个找到目标的 ...

果然是这样。今天用立即窗口把这些起点和终点都打印出来。原来dw的起点，终点一直在发生变化的。不变的是开始所选区域的起点和终点。