使用VBA在Word文檔中填充Excel數據

Question

我有一個Word文檔，我想填充來自excel的相同單詞。 可以說它們都位於c：\\ test中，我對使用vba有一定的了解，但是這個有點過頭了。 在我的Word文檔我有一句話可以說：我firstname lastname和我的用戶名是username ，這是我的部門： department

我有一個稱為data的excel，有一個名為sheet1的工作表，其中包含一個名為users的表和一些列：用戶名，名字，姓氏，部門。 該表是一個odbc連接表，在工作簿打開時將刷新。

1. 我的第一個問題是我應該使用哪種對象的名字，姓氏，用戶名和語言修飾？ 我插入了富文本控件內容，並在其中保留了一個舊式表單/文本表單字段，並將書簽重命名為名字，姓氏等。
2. 我想使用宏和vlookup從excel中用字填充數據。 我真的不知道該如何完成，我有一些代碼，但是它不起作用。 宏啟動后，會彈出一個窗口詢問username並根據該值填寫其他框。

下面的代碼：

Dim objExcel As Object
Set objExcel = CreateObject("Excel.Application")
Dim username As String
Dim firstname As String
Dim lastname As String
Dim department As String

username = InputBox("Please enter the username", "Input")

Set exWb = objExcel.Workbooks.Open("C:\test\data.xlsx")

username = objExcel.WorksheetFunction.VLookup(username, _
 eexWb.ActiveSheet.Range("A:F"), 1, False)

firstname = objExcel.WorksheetFunction.VLookup(username, _
 eexWb.ActiveSheet.Range("A:F"), 2, False)

lastname = objExcel.WorksheetFunction.VLookup(username, _
 eexWb.ActiveSheet.Range("A:F"), 3, False)

department = objExcel.WorksheetFunction.VLookup(username, _
 eexWb.ActiveSheet.Range("A:F"), 4, False)

exWb.Close

Set exWb = Nothing

Answer 1

下面的代碼應該可以滿足您的需求。 請注意以下幾點：

1. 我使用了早期綁定（以利用智能感知）。 在Word VBE中的“工具”>“引用”中，檢查Microsoft Excel XX.X對象庫
2. 您可以創建簡單的書簽，而無需插入對象。 您可能仍然希望這樣做，但是您可能需要調整UpdateBookmark過程以使其正常工作。

碼：

Sub LoadInfo()

    Dim objExcel As Excel.Application 'note early binding (set in Tools > References > Microsoft Excel XX.X library
    Set objExcel = New Excel.Application

    Dim username As String
    Dim firstname As String
    Dim lastname As String
    Dim department As String

    username = InputBox("Please enter the username", "Input")

    Dim exWB as Excel.Workbook        
    Set exWB = objExcel.Workbooks.Open("C:\test\data.xlsx")

    With exWB.Worksheets("Sheet1")

        Dim rngUN As Excel.Range
        Set rngUN = .Columns("A").Find(what:=username, lookat:=xlWhole)

        If Not rngUN Is Nothing Then

            firstname = rngUN.Offset(, 2)
            lastname = rngUN.Offset(, 3)
            department = rngUN.Offset(, 4)

        Else

            MsgBox "Username Not Found. Exiting Sub"
            GoTo ExitSub

        End If

    End With

    UpdateBookmark "username", username, ActiveDocument, False
    UpdateBookmark "firstname", firstname, ActiveDocument, False
    UpdateBookmark "lastname", lastname, ActiveDocument, False
    UpdateBookmark "department", department, ActiveDocument, False

ExitSub:
        exWB.Close
        objExcel.Quit


    End Sub

Sub UpdateBookmark(BookmarkToUpdate As String, TextToUse As String, wDoc As Word.Document, Optional bReplace As Boolean)
'updates a bookmark range in Word without removing the bookmark name

    Dim BMRange As Word.Range
    Dim sTest As String

    With wDoc

        Set BMRange = .Bookmarks(BookmarkToUpdate).Range

        'if text already exists, add new to old with a carriange return in between
        sTest = BMRange.Text

        If sTest = "" Or bReplace Then

            BMRange.Text = TextToUse

        Else

            BMRange.Text = sTest & vbCr & TextToUse

        End If

        .Bookmarks.Add BookmarkToUpdate, BMRange

    End With

End Sub