用VBA填充word文档中的excel数据

我有一个word文档，我想填充来自excel的同样的话。 可以说，两者都位于C：\testing我有一些使用VBA的知识，但这一点是有点过了。 在我的文档中，我有一句话让我们说：我是firstname lastname ，我的用户名是username ，这是我的部门： department

我有一个名为数据的excel，一张名为sheet1的表与一个名为users的表和一些列：username，firstname，lastname，department。 该表是一个odbc连接的表，并在工作簿打开时刷新。

1. 我的第一个问题是，我应该使用什么样的对象名字，姓氏，用户名，单词中的部门？ 我插入了一个富文本控件内容，并在其中一个传统的表单/文本格式字段，并将书签重命名为名字，姓氏等。
2. 我想使用macros和vlookup从Excel中填充单词中的数据。 我真的不知道如何做到这一点，我有一些代码，但它不起作用。 当macros启动一个窗口应该popup询问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. 您可以创build一个简单的书签，无需插入对象。 您可能仍然希望这样做，但您可能需要调整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