缺less从Excel到Word书签的复制文本

我试图复制文本从Excel单元格到单词的具体位置。 这些地方是word doc中各个页面上的书签放置位置。

在vba作品下面,但有时复制的文本不存在。 有时它会错过3,有时5,有时只有1书签。 对于给定的书签,丢失的文本每次都是不同的。 我试图通过Application.Wait()减慢vba,但是这没有帮助。 看来沟通excel-word不是100%。 我对此没有其他解释。

这是vba:

 rArray1 = Array("s145:f145","s146:f146",.......) rArray2 = Array("s155:f155","s156:f156",.......) For i = 0 To 2 Application.ScreenUpdating=False Application.EnableEvents=False Err.Clear If WordApp Is Nothing Then Set WordApp=CreateObject(class:="Word.Application") Word.Visible=True WordApp.Activate myDoc.SaveAs Filename:=("C:/.........") ActiveWorkbook.Sheets("Doc").Select Set texttb1 = ActiveSheet.Range(rArray1(i)) texttb1.Copy myDoc.Bookmarks("Bookmark01").Select myDoc.Bookmarks("Bookmark01").Range.PasteSpecial DataType:=wdPasteText Set texttb2 = ActiveSheet.Range(rArray2(i)) texttb2.Copy myDoc.Bookmarks("Bookmark02").Select myDoc.Bookmarks("Bookmark02").Range.PasteSpecial DataType:=wdPasteText .... .... Next i 

你可以看到我是vba初学者。 我相信vba可以大大提高。 但是,为什么复制的文本有时会丢失? 谢谢。

至于你的问题,我的基础是关键是补充

 Application.CutCopyMode = False 

在每个.PasteSpecial语句之后,清除剪贴板中的Excel数据

至于整体的代码设置,让我提出下面的build议

 Option Explicit Public WordApp As Object ' declare a public variable to hold Word application reference Public WordClose As Boolean ' declare a public variable to hold what to do of Word application before the macro runs Sub main() Dim rArray1 As Variant, rArray2 As Variant Dim i As Long Dim myDoc As Word.Document rArray1 = Array("s145:f145", "s146:f146") rArray2 = Array("s155:f155", "s156:f156") Application.ScreenUpdating = False Application.EnableEvents = False GetWord ' have the procedure "GetWord" take care of getting a running instance of Word or set a new one Set myDoc = WordApp.Documents.Open(Filename:="C:\MyFiles\MyDoc.doc") '<== set the proper path and name document. you may want to wrap this in a function to handle possible errors ("file not found", etc,...) For i = LBound(rArray1) To UBound(rArray1) 'Warning: we're assuming rArray1 and rArray1 have the same length Call MyPaste(ActiveWorkbook.Sheets("Doc").Range(rArray1(i)), myDoc, "Bookmark01") Call MyPaste(ActiveWorkbook.Sheets("Doc").Range(rArray2(i)), myDoc, "Bookmark02") Next i LeaveWord myDoc ' have the procedure "LeaveWord" take care of leaving Word properly and accordingly to what previuously defined Application.ScreenUpdating = True Application.EnableEvents = True End Sub Sub GetWord() WordClose = False On Error Resume Next Set WordApp = GetObject(, class:="Word.Application") 'try and get an already running instance of Word If WordApp Is Nothing Then Set WordApp = CreateObject(class:="Word.Application") ' since there was no Word running instance, create a new instance of it Word.Documents.Add WordClose = True ' after the macro runs, the new Word instance will be quit unless otherwise specified in "LeaveWord" sub calling arguments End If On Error GoTo 0 WordApp.Visible = False ' for speeding it up, make Word "invisible" End Sub Sub LeaveWord(myDoc As Word.Document, Optional keepOpen As Variant) ' farewell to Word ' it handles both Word and variables connected to it If IsMissing(keepOpen) Then keepOpen = Not WordClose ' default is closing Word if an instance of it has been created specifically opened for this macro If Not WordApp Is Nothing Then With WordApp If Not keepOpen Then .Quit Else .ScreenUpdating = True .Visible = True .Activate End If End With Set myDoc = Nothing Set WordApp = Nothing End If End Sub Sub MyPaste(excelRng As Range, wordDoc As Word.Document, bookMarkName As String) If wordDoc.Bookmarks.Exists(bookMarkName) Then On Error GoTo errlabel excelRng.Copy wordDoc.Bookmarks(bookMarkName).Range.PasteSpecial DataType:=wdPasteText Application.CutCopyMode = False '<== clear Excel data from the clipboard Exit Sub errlabel: MsgBox Err.Description ' ... whatevere else you may need to do to handle/properly notify the error On Error GoTo 0 End If End Sub