将数据从Excel传输到MS Word

Question

我需要一个VBA代码来更新我的Word文件。 它包含一些必须从excel文件更新的表。 Excel文件包含具有不同轴承编号的轴承数据。 而且我的报告必须使用方位值进行更新。 就像我的下一个报告一样，如果我只是输入其他方位文件，它必须从该文件读取所有方位数据。

这必须分3个步骤完成。 我已附上样本图片。 首先确定始终在A列中的轴承名称（在这种情况下，我需要找到（248_R），38.7％）。 然后选择6 * 6矩阵数据（假设我在A946中找到了方位数据，那么我需要将数据从B950记录到G955中），然后传输到word文件中（仅将值存储到表格中）。 我是VBA编码的新手，有人可以帮忙吗？

下方带有矩阵的样品轴承名称的图像

单词文档中表格的外观图像：

Answer 1

复制所需范围的第一部分相对容易。 您可以使用以下代码复制所需的矩阵。 我尚不确定要粘贴到Word文档中，请给我更多时间。 （目前，如果运行此宏，则将复制所需的范围。然后，您可以切换到Word文档，然后按Ctrl + V将其粘贴到所需的表中。

另外，请检查并查看是否添加了以下参考：

Option Explicit

Sub findBearingDataAndPasteToWord()
    Dim i As Integer
    Dim aCell As Range, rng As Range
    Dim SearchString As String

    Set rng = Range("A750:A1790")
    SearchString = "(248_R), 38,7 %"

    For Each aCell In rng
        If InStr(1, aCell.Value, SearchString, vbTextCompare) Then
            ActiveSheet.Range(Cells(aCell.row + 4, 1), Cells(aCell.row + 9, 6)).Copy

            Dim wrdApp As Word.Application
            Dim docWd As Word.Document

            MsgBox "Please select the word document that you want to paste the copied table data into (after pressing OK)" & _
                vbNewLine & vbNewLine & "Script written by takanuva15 with help from Stack Overflow"
            docFilename = Application.GetOpenFilename()
            If docFilename = "False" Then Exit Sub
            Set docWd = getDocument(docFilename)
            Set wrdApp = docWd.Application

            wrdApp.Selection.EndKey Unit:=wdStory
            wrdApp.Selection.TypeParagraph
            wrdApp.Selection.TypeParagraph
            wrdApp.Selection.PasteExcelTable False, True, False

            Exit Sub
        Else: End If
    Next aCell
End Sub

'Returns the document with the given filename
'If the document is already open, then it returns that document
Public Function getDocument(ByVal fullName As String) As Word.Document
    On Error Resume Next
    Set wrdApp = GetObject(, "Word.Application")
    If wrdApp Is Nothing Then Set wrdApp = CreateObject("Word.Application")
    wrdApp.Visible = True

    Dim fileName As String
    Dim docReturn As Word.Document

    fileName = Dir(fullName)
    Set docReturn = Word.Documents(fileName)
    If docReturn Is Nothing Then
        Set docReturn = Word.Documents.Open(fullName)
    End If
    On Error GoTo 0
    Set getDocument = docReturn
End Function