麻烦老师帮忙看看，为什么有时候不运行

zhgj007

录了个宏，又调整了下，目的是把word文档中的红色字体，复制到文档末尾。

但发现，有时能达到目的，有时不行，我分析，认为有可能是这个撤销操作“ActiveDocument.Undo”
的问题，哪位老师帮忙看看什么问题，需要怎么调整。



Sub 红色内容复制到结尾()
    On Error Resume Next
  Dim myDoc As Document
   
    Set myDoc = ActiveDocument
   With myDoc.Find

Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
  Selection.Find.Font.Color = wdColorAutomatic
  Selection.Find.Replacement.ClearFormatting
   Selection.Find.Execute Replace:=wdReplaceAll
Selection.WholeStory '全选
    Selection.Copy '复制
ActiveDocument.Undo
End With


Selection.EndKey Unit:=wdStory
  Selection.TypeParagraph
   Selection.Paste
   
    myDoc.Save

Set myDoc = Nothing
   
  
End Sub

过客fppt

我也弄过类似的操作，复制一次两次还是可以的，如果让代码循环复制十几二十道题的答案到末端的话，会有一些答案复制不过来，我认为是因为频繁占用剪切板导致的，所以就让代码每复制四道题就弹出窗口，点一下再复制后面的四道，就解决这个问题了，当然我也不知道这个方法好不好， 也希望大神们解惑

过客fppt

zhgj007 老师晚上好，您的这个资料真的排版好看，内容也感觉很棒，希望能够告知一下是在什么网站下载的，先谢谢了！

batmanbbs

过客fppt

这个运行过了，完全没问题，顺便把答案解析也做好了

过客fppt

查找中，查找条件红色字体应该是:wdColorRed

zhgj007

加了2次撤销，加了一次回车，也暂时解决。
再试试各位老师的代码，先谢谢各位老师

zhgj007

过客fppt 发表于 2023-8-12 06:49
查找中，查找条件红色字体应该是:wdColorRed

把黑色删除，剩余的就是红色，这样操作简单，确定是慢

zhgj007

过客fppt 发表于 2023-8-12 06:44
结合最近在论坛里学到的选中全部的代码，只复制一次应该可以了

Sub 选中所有红色字体复制到文档末端()

老师你好，先谢谢你的帮助。代码运行时“Selection.Copy”，总是红色，运行不过去

zhgj007

batmanbbs 发表于 2023-8-12 00:54

老师好，您的代码比我调整后的，运行速度快多了。但是，运行完，文档还是老样子，是不是“Activate: .Undo”，位置有问题？