Question

我正在尝试将文本从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可以大大改进。但是为什么复制文本有时会丢失？谢谢。

Answer 1

关于你的问题，我的基础是关键是添加

Application.CutCopyMode = False

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

关于整体代码设置，让我提出以下内容

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

缺少复制的文本从excel到文字书签

1 个答案: