如何更新单词表? [英] how to update table in word?

问题描述

我正在研究轴承报告.我必须从excel文件中复制并找到相关的方位数据，并将其粘贴到word表中.我已经找到了

I am working on the bearing report. I have to copy and find the relevant bearing data from the excel file and paste it in the word table. I have figured out the codes to

1. 要转到Word文件中的相对位置，然后将某些数据粘贴到所需的Word文档中.

1. To go to the relavant location in the word file and paste some data in desired word document.

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

转到excel文件中的位置，找到相关数据并复制与此相关的数据，这是该代码.

Go to the location in the excel file, find the relevant data and copy the data related to that and here is the code for that.

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中进行操作.但是现在我必须将两者结合起来，并将从第二个代码复制的数据粘贴到位于第一个代码中的表中(该位置不只是在我找到单词的位置之后.要转到该位置，我知道代码，并且可以通过下面的图片更好地理解.)

I have written both these codes to be operated from Excel VBA. But Now I have to combine both and paste the copied data from 2nd code to the table which is located in the 1st code (The location of the place is not just after the location where i find the word. To go to that location I know the code and can be better understood by the pics given below.).

这是我用来在需要替换的单词中选择数据的代码.我需要用词写类似的东西，然后用复制的数据替换

This is the code for me to select the data in the word where I need to replace. I need to write similar in word and replace that with the copied data

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

不幸的是，尽管我已经复制了我想要的数据，但我仍无法找到解决方案.我不知道如何将数据粘贴到现有表中.

Unfortunately, Though I have copied the data what I want I am not able to arrive at the solution. I don't know how to paste data in the existing table.

此图片说明得更好.我需要在excel中搜索轴承248_R的数据并将其粘贴到word中.这是Word文件

This picture explains better. I need to search data of bearing 248_R in excel and paste that in word. This is the Word file

这是Excel文件

推荐答案

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

感谢您的支持人员.:)

Thanks for your support people. :)

这篇关于如何更新单词表?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！