使用VBA填充word文檔中的excel數據

Question

我有一個word文檔，我想填充來自excel的相同單詞。可以說，兩者都位於c：\ test 我有一些使用vba的知識，但是這個有點超過它。 在我的Word文檔我有一句話可以說： 我firstnamelastname和我的用戶名是username，這是我的部門：department

我有一個Excel稱爲數據，與表的紙張稱爲Sheet1中被叫用戶和一些列：用戶名，名字，姓氏，部門。該表是一個odbc連接的表，它在工作簿打開時刷新。

1. 我的第一個問題是，我應該使用什麼樣的對象名字，姓氏，用戶名，單詞中的deparment？我插入了一個富文本控件內容，並在那個傳統的表單/文本格式字段中，並將書籤重命名爲名字，姓氏等。
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. 我使用了早期綁定（以利用intellisense）。在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