2016-04-17 10 views
0

Excelのセルから単語の特定の場所にテキストをコピーしようとしています。これらの場所は、ワードdoc内の個々のページにブックマークの場所です。コピーしたテキストがExcelブックから単語ブックマークに抜けています

以下ではvbaが動作しますが、コピーされたテキストはありません。ときには3、時には5、時には1つのブックマークが欠けてしまうことがあります。欠落しているテキストは、指定されたブックマークごとに異なります。私はApplication.Wait()でvbaを遅くしようとしましたが、これは助けになりませんでした。コミュニケーションのエクセルワードは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が大幅に改善できると確信しています。しかし、なぜコピーされたテキストが時々見つからないのですか?ありがとうございました。ご質問のように、私のfoundingsはキーが私を聞かせて、全体的なコードの設定にとしてクリップボード

からExcelデータを消去するには、右の各.PasteSpecial文の後

Application.CutCopyMode = False 

を追加することであるということである

+0

あなたのforループは...変です。 wordappはその中に再作成しますが、docという単語は作成しません。どうして?私はそれを掃除することから始めるだろう。毎回やり直す必要のないすべてのものを置く。 'screenupdating'、' enableevents'、 'wordapp.'のように。また、あなたの「言葉」は何ですか? 'Word.Visible'で。 'Wordapp.Visible'とされていますか?そのコードを少しクリーンアップして、それが役立つかどうかを確認してください... – vacip

答えて

1

次のものを提案してください

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 
+0

ありがとうございます。いいね。私は明日あなたの発言を適用します。これが助けになると私は確信しています。 – Maximilian

関連する問題