Question

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

转到word文件中的relavant位置，并将一些数据粘贴到所需的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

转到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文件

这是Excel文件

Answer 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）需要转到cell（1,1）

希望这能让你开始

Answer 2

(defun ggshell (&optional buffer)
(interactive)
(let* (
       (tramp-path (when (tramp-tramp-file-p default-directory)
             (tramp-dissect-file-name default-directory)))
       (host (tramp-file-name-real-host tramp-path))
       (user (if (tramp-file-name-user tramp-path)
         (format "%s@" (tramp-file-name-user tramp-path)) ""))
       (new-buffer-nameA (format "*shell:%s*" host))
       (new-buffer-nameB (generate-new-buffer-name new-buffer-nameA))
       (currentbuf (get-buffer-window (current-buffer)))
       )
  (generate-new-buffer new-buffer-nameB)
  (set-window-dedicated-p currentbuf nil)
  (set-window-buffer currentbuf new-buffer-nameB)
  (shell new-buffer-nameB)
  ))

感谢您的支持。 :)

如何用word更新表？

2 个答案: