將數據從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