Question

从VBA打开的WORD文档中复制两个关键字间的内容（包含格式），并粘贴到当前WORD文档中

比如文档B中有如下内容：规定给“更的非官方的”孤独感风结束需要复制“规定”与“结束”之间的所有内容（带格式），并将其粘贴到文档A的表格的第一个单元格cell(1,1)中，最后保存关闭文档B请注意：是要求从VBA中打开的文档B复制，在当前文档A中粘贴，而不是A中复制，B中粘贴 Sub DoThis() Selection.Find.ClearFormatting With Selection.Find .Text = "规定" .Wrap = wdFindContinue End With Selection.Find.Execute a = Selection.End Selection.Find.ClearFormatting With Selection.Find .Text = "结束" .Wrap = wdFindContinue End With Selection.Find.Execute b = Selection.Start Selection.Start = a + 1 Selection.End = b Selection.CopyEnd Sub这个代码只能在当前文档中进行复制、粘贴，不能达到要求
草原上之狼：我用你的第二个代码，但是执行不了
我自己的代码执行到 Selection.Copy 时出错，级别不够，上传不了代码，我截图出来吧

文档A初始状态：

文档B：





Answer 1

'打开后焦点发生了转移，activedocument已经指向刚打开的文件了
'改为
Sub Macro1()
Dim myDoc
'On Error Resume Next
With ActiveDocument.Tables(1).Cell(Row:=1, Column:=3).Range
Set myDoc = Word.Application.Documents.Open("E:\1.docx")
.Delete
.InsertAfter Text:=myDoc.Tables(2).Cell(Row:=1, Column:=2)
End With
End Sub
'（
InsertAfter Text:=myDoc.Tables(2).Cell(Row:=1, Column:=2)这行代码中，你确定表2存在吗？我测试时只建一个表，所以改为Tables(1).

）

'也可以这样控制焦点
Sub Macro1()
Dim myDoc
'On Error Resume Next
Set myDoc = Word.Application.Documents.Open("E:\1.docx", , , , , , , , , , , vbHide)
With ActiveDocument.Tables(1).Cell(Row:=1, Column:=3).Range
.Delete
.InsertAfter Text:=myDoc.Tables(2).Cell(Row:=1, Column:=2)
End With
End Sub

追问

你这个执行不了啊