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

将数据从excel传输到MS字

1 个答案: