将数据从excel传输到MS word

Question

我需要一个 VBA 代码来更新我的 word 文件。它由一些必须从 excel 文件更新的表组成。 Excel 文件由不同轴承编号的轴承数据组成。我的报告必须用轴承值更新。就像我的下一份报告一样，如果我只是输入不同的轴承文件，它必须从该文件中读取所有轴承数据。

这必须分 3 步完成。我附上了一张示例图片。首先确定始终在 A 列中的轴承名称（在这种情况下，我需要找到 (248_R), 38,7 % ）。然后选择6*6的矩阵数据（假设我发现方位数据在A946，那么我需要记录B950到G955的数据）然后传输到word文件（只有表中的值）。我是 VBA 编码的新手，有人可以帮忙吗？

image of sample bearing name with matrix underneath

表格在 word 文档中的样子：

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