使用Word VBA将特定的Excel单元格值提取到Word文档中

Question

我对VBA和宏不了解。

我需要重复一个任务，将数据从Excel复制并粘贴到Word文档的特定位置。

例如，我的Excel表格中有以下数据：

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

现在我正在寻找一个Word宏，

1. 获取Word表格中单元格位置为3的文本
2. 在Excel Col1中查找相同的文本
3. 获取Excel Col2的值
4. 将Col2的值粘贴到Word表格中单元格位置为10
5. 对Word文档中的另一个表格重复相同的过程

[更新] 我已经尝试了多个通过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

我使用这个链接构建我的骨架代码：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循环之前就显示出来了。

请帮忙解决。

- Vinay

---

欢迎来到Stack Overflow。请注意，由于这不是免费代码编写服务，因此必须展示您已经尝试过什么以及遇到的问题或错误（通过展示您的代码），或至少展示您所研究的内容和投入的努力。否则，这就等同于要求我们替你完成所有工作。阅读[提问指南]可能有助于您改进问题。 - Pᴇʜ

@Pᴇʜ 感谢您的及时回复。我已经理解并更新了描述，包括我使用的源代码片段以及在尝试获取文本时遇到的错误。谢谢。 - Vinay

“cell position 3”是什么意思？是指单行/单列表格吗？ - CDP1802

嗨@CDP1802，单元格位置3表示在一个表格中计算所有单元格的数量，但不是基于行或列。例如，如果一个有2行3列（R2XC3矩阵）的表格，则单元格位置3的位置为R1XC3。 - Vinay

Answer 1

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

为了在将来添加的所有新代码中激活它，你可以直接在Excel和Word中激活它。这是一个好习惯，会通过通知你未声明的变量来保护你免受错误影响：

在VBA编辑器中转到 工具 › 选项 › 要求变量声明。

这将仅向新模块添加Option Explicit。在现有模块中，需要手动添加Option Explicit作为第一行。

此外，我强烈建议根据其内容命名变量，否则会变得非常混乱。你将变量命名为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

- Pᴇʜ

---

感谢 @Pᴇʜ 的帮助。它对我获取单元格值很有用。 - Vinay

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

- CDP1802