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

Question

I am new to VBA and macros.

I got the repeated task of copy data from Excel and paste it in a particular location in the word document.

For example, my excel sheet has the data like this:

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

Now i'm looking for a Word macro

1. Get text in Word table with cell position 3
2. Find the same text in Excel Col1
3. Get the value of Col2 from Excel
4. Paste the value of Col2 in word table with cell position 10
5. Repeat the same process for another table in Word document

[Update] I have tried with multiple code snippets by google search but unable to construct the working macro.

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

I used this url to construct my skeleton code: https://www.macworld.com/article/211753/excelwordvisualbasic.html

When i try to get the values from the range of cells in excel, i got the following error for the code.

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

The above line gives "Object required" error when running.

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

The above line gives "Type Mismatch" error when running. Notes: For this error, I tried to use for each loop as this is array but the error is showing before executing the for loop.

Kindly assist.

Answer 1

I recommend to use Option Explicit and declare all your varibales properly. This way it is less likely that you end up with unseen errors.

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.

Further I highly recommend to name your variables according what they contain because otherwise it gets very confusing. You named your variable xlSheet but you load a workbook into it and not a worksheet.

The next issue is that your code is in Word and if you declare rng As Range then this is of type Word.Range and not Excel.Range and those are diffetent types so that is why you get a "Type Mismatch" error. To solve this you either go in Word VBA to Extras › Refereces … and set a reference to the Excel library so you can declare your variable Dim xlRng As Excel.Range or if you don't set a reference you declare it as Object or Variant like in below example:

' 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

---

Note if your workbook Set xlWorkbook = GetObject("D:\Excel.xlsx") is not open in Excel you need to use CreateObject("Excel.Application") and open it.

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