Using Excel data to create Word Doc caption labels in VBA

问题

I am trying to link a Word document report to an Excel database with VBA. I inserted various ActiveX text box controls in my document. I am manually entering each one of these text boxes with unique code ("Code"). The other text box controls will automatically populate based on the associated data in the Excel database. The matching factor will be the "Code".

When I run the following code, I receive a

Run Time Error 13 "Type Mismatch"

on Row 16 (If cell.Value...). I don't have a lot of experience in VBA but I have seen many examples showing that the Value command should be tied to a 'Range' object. Thank you for your help.

Private Sub CommandButton1_Click()

Dim objExcel As New Excel.Application
Dim exWb As Excel.Workbook
Dim b As Excel.Range
Dim c As Excel.Range
Dim r As Excel.Range
Dim cell As Excel.Range

'Set variables
Set exWb = objExcel.Workbooks.Open("C:\Documents\Book.xlsx")
Set b = exWb.Sheets("Sheet1").Range("B:B")
Set c = exWb.Sheets("Sheet1").Range("C:C")
Set r = exWb.Sheets("Sheet1").Rows
Set cell = exWb.Sheets("Sheet1").Range("A1:Z1000")

For Each r In c
    If cell.Value = ThisDocument.TextBox1.Value Then
        ThisDocument.TextBox2.Value = b.Value
   End If
Next r

exWb.Close
Set exWb = Nothing

End Sub

回答1:

You can try something like this:

Private Sub CommandButton1_Click()

    Dim objExcel As New Excel.Application
    Dim exWb As Excel.Workbook
    Dim rng As Excel.Range, m, rw As Excel.Range

    'Set variables
    Set exWb = objExcel.Workbooks.Open("C:\Documents\Book.xlsx")
    Set rng = exWb.Sheets("Sheet1").Range("A1:Z1000")

    'Here we're looking for a match in ColC...
    '  change 3 to any other column you want to match on
    m = objExcel.Match(ThisDocument.TextBox1.Value, rng.Columns(3), 0)

    If Not IsError(m) Then

        'got a match - fetch the other values from that row
        Set rw = rng.Rows(m) '<< get the matching row as a Range
        ThisDocument.TextBox2.Value = rw.Cells(1).Value 'value from colA
        ThisDocument.TextBox3.Value = rw.Cells(2).Value 'value from colB

    Else
        'no match - clear the other textboxes?
        MsgBox "No match found!"
        ThisDocument.TextBox2.Value = ""
        ThisDocument.TextBox3.Value = ""
    End If

    exWb.Close False 'no changes saved
    Set exWb = Nothing

End Sub

来源：https://stackoverflow.com/questions/59849187/using-excel-data-to-create-word-doc-caption-labels-in-vba

标签

excel

vba

ms-word

activexobject