使用 Word VBA 将特定 Excel 单元格值拉入 Word 文档

Question

我是 VBA 和宏的新手。

我得到了从 Excel 复制数据并将其粘贴到 word 文档中特定位置的重复任务。

比如我的excelsheet有这样的数据：

Col1	Col2
ID_1	I'm_One
ID_2	I'm_Two
ID_3	I'm_Three

现在我正在寻找 Word 宏

在单元格位置 3
在 Excel Col1
从Excel
将 Col2 的值粘贴到单元格位置 10
在 Word 文档中对另一个 table 重复相同的过程

[更新] 我已通过 google 搜索尝试使用多个代码片段，但无法构建工作宏。

Sub pull_from_Excel2()
    'ref: https://www.macworld.com/article/211753/excelwordvisualbasic.html
    
    Dim Month As String
    
    ID_Range = "A2:A6"     'Select this as range like "A2:A16"
    Offset_to_fetch = 1         'Select this to fetch comments etc. value starts with
    
    Set xlSheet = GetObject("D:\Excel.xlsx")
    
     
    'Snippets:
    'Debug.Print VarType(xlSheet.Worksheets("Sheet1").Range("A3:A5").Value)
    '8204
    
    Dim Cell As Range, rng As Range
    
    Debug.Print VarType(xlSheet.Worksheets("Sheet1").Range(ID_Range).Value2)
   
    Set rng = xlSheet.Worksheets(1).Range(ID_Range)
    
    For Each Cell In rng
        Debug.Print Cell.Text
    Next Cell
  
End Sub

我用这个 url 构建了我的框架代码：https://www.macworld.com/article/211753/excelwordvisualbasic.html

当我尝试从 excel 中的单元格范围获取值时，我收到以下代码错误。

Set rng = xlSheet.Worksheets(1).Range(ID_Range).Value2

当运行.

时，以上行给出“需要对象”错误

Set rng = xlSheet.Worksheets(1).Range(ID_Range)

以上行在运行时出现“类型不匹配”错误。注意：对于这个错误，我尝试使用 for each 循环，因为这是数组，但在执行 for 循环之前显示错误。

请提供帮助。

Answer 1

我建议使用 Option Explicit 并正确声明所有变量。这样你就不太可能遇到看不见的错误。

To activate it for all new codes that you add in the future, you can activate it directly in Excel and Word. This is a good practice and will protect you from doing it wrong by notifying you of not declared variables:

In the VBA editor go to Tools › Options › Require Variable Declaration.

This will add Option Explicit to new modules only. In existing modules Option Explicit needs to be added manually as first line.

此外，我强烈建议根据变量包含的内容来命名变量，否则它会变得非常混乱。您将变量命名为 xlSheet，但将工作簿而不是工作表加载到其中。

下一个问题是您的代码在 Word 中，如果您声明 rng As Range 那么这是 Word.Range 类型而不是 Excel.Range 类型，这就是为什么您收到 “类型不匹配” 错误。要解决这个问题，您可以在 Word VBA 中转到 Extras › Refereces … 并设置对 Excel 库的引用所以你可以声明你的变量 Dim xlRng As Excel.Range 或者如果你没有设置引用你将它声明为 Object 或 Variant 如下例所示：

' This code is in Word!

Option Explicit

Public Sub pull_from_Excel2()
    'declare constants
    Const ID_Range As Sting = "A2:A6"     'Select this as range like "A2:A16"
    Const Offset_to_fetch As Long = 1         'Select this to fetch comments etc. value starts with
    
    Dim xlWorkbook As Object
    Set xlWorkbook = GetObject("D:\Excel.xlsx") 'This expects the Excel to be already open! If not open you need to use CreateObject("Excel.Application")
    
    Dim xlRng As Object
    Set xlRng = xlWorkbook.Worksheets(1).Range(ID_Range)
    
    Dim xlCell As Object
    For Each xlCell In xlRng 
        Debug.Print xlCell.Text
    Next xlCell 
End Sub

请注意，如果您的工作簿 Set xlWorkbook = GetObject("D:\Excel.xlsx") 未在 Excel 中打开，您需要使用 CreateObject("Excel.Application") 打开它。

Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")

Dim xlWorkbook As Object
Set xlWorkbook = xlApp.Workbooks.Open(FileName:="D:\Excel.xlsx") 'will open the workbook
xlApp.Visible = True 'make it false to open Excel invisible in the background

'your code here …

'in the end close workbook and Excel (espaciall if you had it invisible!)
xlWorkbook.Close SaveChanges:=False  
xlApp.Quit 'close Excel

Answer 2

Option Explicit

Sub UpdateTables()

    Const XLSX = "D:\Excel.xlsx"

    Dim xlApp, wb, ws
    Dim rngSearch, rngFound
    Dim iLastRow As Long, n As Integer

    ' open spreadsheet
    'Set xlApp = New Excel.Application
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True

    Set wb = xlApp.Workbooks.Open(XLSX, 1, 1)
    Set ws = wb.Sheets(1)
    iLastRow = ws.Cells(ws.Rows.Count, "A").End(-4162).Row  'xlUp
    Set rngSearch = ws.Range("A2:A" & iLastRow)

    ' update tables
    Dim doc As Document, tbl As Table, s As String
    Set doc = ThisDocument
    For Each tbl In doc.Tables
         s = tbl.Cell(1, 1).Range.Text
         s = Left(s, Len(s) - 2)
         Set rngFound = rngSearch.Find(s, LookIn:=-4163, LookAt:=1) ' xlValues, xlWhole
         If rngFound Is Nothing Then
             MsgBox "'" & s & "' not found in table " & tbl.Title, vbExclamation
         Else
             tbl.Range.Cells(3).Range.Text = rngFound.Offset(0, 1)
             n = n + 1
         End If
    Next

    wb.Close False
    xlApp.Quit
    MsgBox n & " tables updated", vbInformation

End Sub

使用 Word VBA 将特定 Excel 单元格值拉入 Word 文档

Pull particular Excel cell value into Word document using Word VBA

excel

vba

ms-word