2017-07-24 86 views
0

我正在研究軸承報告。我必須複製並從Excel文件中找到相關的方位數據並將其粘貼到單詞表中。我已經計算出代碼如何更新單詞表?

  1. 要轉到word文件中的相關位置,並在所需的word文檔中粘貼一些數據。

    Sub CreateNewWordDoc() 
        Dim wrdApp As Word.Application 
        Dim wrdDoc As Word.Document 
        Dim i As Integer 
        Dim arr(12) 
        'Bearing numbers I need to search 
        arr(0) = "(249_L), 38,7 %" 
        arr(1) = "(248_R), 38,7 %" 
        arr(2) = "(249_M), 38,7 " 
        arr(3) = "(3560), 38,7 " 
        arr(4) = "(3550), 38,7 %" 
        arr(5) = "(349_), 38,7 %" 
        arr(6) = "(348_), 38,7 %" 
        arr(7) = "(451), 38,7 %" 
        arr(8) = "(450L), 38,7 " 
        arr(9) = "(450R), 38,7 " 
        arr(10) = "(151), 38,7 %" 
        arr(11) = "(150L), 38,7 %" 
        arr(12) = "(150R), 38,7 %" 
        Set wrdApp = CreateObject("Word.Application") 
        wrdApp.Visible = True 
        'location of my word document 
    
        Set wrdDoc = wrdApp.Documents.Open("E:\ShareDrive_Ruehl\full-flexible-MBS-models_report\example-report\FullFlexibleGearbox - Copy (2).docx") 
        wrdDoc.Activate 
    
        wrdApp.Selection.HomeKey unit:=wdStory 
        'for loop to reach all bearing location 
        For i = 0 To 12 
         With wrdApp.Selection 
          With .Find 
           .ClearFormatting 
           .MatchWildcards = False 
           .MatchWholeWord = False 
           .Text = arr(i) 
           .Execute 
          End With 
          ' Here is where I need to paste my copied data. 
    
          .InsertAfter "I can just paste this shit" 
          .HomeKey unit:=wdStory 
         End With 
        Next 
    End Sub 
    
  2. 轉到Excel文件中的位置,找到相關的數據,並複製相關的數據,這裏是該代碼。

    Sub CopyToWord() 
        'Copy the range Which you want to paste in a New Word Document 
        Cells.Find(What:=arr(0), After:=ActiveCell, LookIn:=xlFormulas _ 
         , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
         MatchCase:=False, SearchFormat:=False).Activate 
        ActiveCell.Offset(2, 0).Range("A1:g8").Select 
        Selection.Copy 
    End Sub 
    

我已經寫了兩個從Excel中VBA運行這些代碼。但現在我必須將第二個代碼中的複製數據粘貼到位於第一個代碼中的表格中(該位置的位置不是在我找到該單詞的位置之後)要去那個位置,我知道代碼,可以通過下面給出的圖片更好地理解)。

這是我選擇單詞中我需要替換的數據的代碼。我需要寫的字相似,替代與複製的數據

Sub pasting() 
    Dim sSample, rResult As String 
    sSample = "(450R), 38,7 % " 

    Set rRange = ActiveDocument.Content 
    Selection.Find.Execute FindText:=sSample, _ 
     Forward:=True, Wrap:=wdFindStop 
    Selection.MoveDown unit:=wdLine, Count:=1 
    Selection.EndKey unit:=wdLine 
    Selection.MoveRight unit:=wdCharacter, Count:=1 
    Selection.EndKey unit:=wdLine 
    Selection.MoveDown unit:=wdLine, Count:=1 

    Selection.MoveDown unit:=wdLine, Count:=5, Extend:=wdExtend 
    Selection.MoveLeft unit:=wdCharacter, Count:=5, Extend:=wdExtend 
    Selection.PasteAndFormat (wdPasteDefault) 
End Sub 

不幸的是,雖然我抄什麼,我想我不能夠在解決辦法的數據。我不知道如何在現有表格中粘貼數據。

這幅圖解釋得更好。我需要在excel中搜索軸承248_R的數據並粘貼到word中。 這是Word文件

enter image description here

這是Excel文件

enter image description here

+0

爲什麼不用你(而不是這個廣泛的VBA腳本)鏈接/嵌入你的Excel數據,如[在Word文檔中嵌入Excel工作表](http://www.excel-easy.com /examples/embed.html)或[將Excel數據鏈接到Word文檔](http://www.k2e.com/tech-update/tips/158-linking-excel-data-into-word-documents)?這會比使用腳本容易得多,並且會自動更新Word中的數據。不要重新發明輪子! –

+0

Peh的建議看起來頗具吸引力。但是,如果這不起作用,請注意您無法將Excel表格中的數據粘貼到現有的Word表格中。您必須將每個Excel單元格的內容寫入每個現有的Word單元格。 – Variatus

+0

感謝您的建議@Peh但我正在編寫一個代碼,如果我插入其他方位數據集,它必須自動更新。我的意思是,如果我把其他Excel表格相同的軸承名稱,但不同的值,它必須自動更新 –

回答

0
Sub CreateNewWordDoc() 
    Dim wrdApp As Word.Application 
    Dim wrdDoc As Word.Document 



    Dim arr(12) 
    'Bearing numbers I need to search 
    arr(0) = "(249_L), 38,7 %" 
    arr(1) = "(248_R), 38,7 %" 
    arr(2) = "(249_M), 38,7 " 
    arr(3) = "(3560), 38,7 " 
    arr(4) = "(3550), 38,7 %" 
    arr(5) = "(349_), 38,7 %" 
    arr(6) = "(348_), 38,7 %" 
    arr(7) = "(451), 38,7 %" 
    arr(8) = "(450L), 38,7 %" 
    arr(9) = "(450R), 38,7 %" 
    arr(10) = "(151), 38,7 %" 
    arr(11) = "(150L), 38,7 %" 
    arr(12) = "(150R), 38,7 %" 

    range2 = 6 


    Set wrdApp = CreateObject("Word.Application") 
    wrdApp.Visible = True 
    'location of my word document 

    Set wrdDoc = wrdApp.Documents.Open("E:\Siemens\FullFlexibleGearbox.docx") 
    wrdDoc.Activate 

    wrdApp.Selection.HomeKey Unit:=wdStory 
    'for loop to reach all bearing location 
    For i = 0 To 12 
      Cells.Find(What:=arr(i), After:=ActiveCell, LookIn:=xlFormulas, _ 
      LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ 
       MatchCase:=False, SearchFormat:=False).Activate 
       ActiveCell.Offset(2, 0).Range("A1:G8").Select 
       Application.CutCopyMode = False 
       Selection.Copy 

     With wrdApp.Selection 
      With .Find 
       .ClearFormatting 
       .MatchWildcards = False 
       .MatchWholeWord = False 
       .Text = arr(i) 
       .Execute 
      End With 
      .MoveRight Unit:=wdCharacter, Count:=2 
      .MoveDown Unit:=wdLine, Count:=1 
      .MoveDown Unit:=wdLine, Count:=6, Extend:=wdExtend 
      .MoveLeft Unit:=wdCharacter, Count:=6, Extend:=wdExtend 
      .Paste 
      .HomeKey Unit:=wdStory 



     End With 
    Next 
    End Sub 

感謝您的支持人員。 :)

1

忘記複製和粘貼。相反,一旦你找到你的數據(在2)將範圍分配給變量類型的變量。它現在將成爲變量內的一個數組 現在,您可以通過將每個元素分配到表格中的單元格來循環使用 我在工作,因此我無法看到您的圖像,但請記住,Word表格中的單元格會被引用爲小區(行,列) - 所以你可以寫

with Wrdapp.documents(1).tables(1) 
     For x = 0 to ubound(v,1) 
      for y = 0 to ubound(v,2) 
      .cell(x + 1,y + 1).range.text = v(x,y) 
      next y 
     next x 

end with 

到陣列V複製到所述第一表的文檔 (在細胞中的+1是因爲數組從零計數,但Word表從一個 所以v(0,0)需要去單元格(1,1)

希望這應該讓你開始