VBA Word Excel 数据交互

现在因公司里面的要求，需要做一个小项目，就是让用户能够在习惯的Word表格里面填写信息，保存后信息自动保存在excel里面，也就是excel与Word之间的信息互转问题。
现在面临的问题是，用excel的VBA打开供用户填写的有着空白表格Word后，Word无法得到excel里面的比如填报人姓名对应的单元格的信息。
比如说，在一个名为“总工月报表.xlsm”里面，我给加了一个控件按钮，点击之后会打开路径为“F：\总工月报表.docm”的有着空白表格的Word文档，"总工月报表.xlsm"的C2单元格的值是填报人的姓名，怎么才能让这个路径为“F：\总工月报表.docm”的有着空白表格的Word文档在打开时，其中的表格的第一行第二列的位置自动写入"总工月报表.xlsm"的C2单元格的值，即填报人的姓名呢？
还望高手不吝赐教
联系方式：cjt92cjt92@163.com

我是使用OFFICE 2003来做的，不知道你那好使不好使
Private Sub CommandButton2_Click()
'防止重复打开同一Word文档导致错误
If Not WordDocIsOpen("F:\总工月报表.doc") Then
'创建Word对象
Set objWordApp = CreateObject("Word.Application")
objWordApp.Visible = True
'打开指定文档
Set objDocument = objWordApp.Documents.Open("F:\总工月报表.doc")
'获取当前Excel的SHEET1的单元格C2数据
strName = ThisWorkbook.Sheets(1).Cells(2, 3).Value
'将取得得值设定到Word表格的1行2列中
objDocument.Tables(1).Cell(1, 2).Range.Text = strName
End If

End Sub

'判断Word文档是否被重复打开
Function WordDocIsOpen(ByVal strDocName As String) As Boolean
Dim objWordApp As Object
Dim objWordDoc As Object
WordDocIsOpen = False
Set objWordApp = Nothing
On Error Resume Next

strDocName = UCase(strDocName)
'判断是否有Word程序被打开
Set objWordApp = GetObject(, "Word.Application")
If Not objWordApp Is Nothing Then
'判断指定Word文件是否被打开
For Each objWordDoc In objWordApp.Documents
If UCase(objWordDoc.FullName) = strDocName Then
WordDocIsOpen = True
Exit For
End If
Next
End If

Set objWordDoc = Nothing
Set objWordApp = Nothing
End Function

将excel和word放在同一目录下, 在excel中建立按钮,双击后输入下列代码: private sub commandbutton1_click() application.screenupdating = false '关闭屏幕刷新 on error resume next '捕捉错误 dim ost as range, wddoc as word.document, wdrange as word.range mypath = thisworkbook.path & "\2.doc" '定义word文件路径,名字自己修改,我设定为2.doc set wddoc = getobject(mypath) '打开word dim key(2) '定义一下数组, key(1) = "abcdefg" '要替换的数据 key(2) = "hijklmn" set wdrange = wddoc.content '将word的文档内容赋予wdrange for i = 1 to 2 '循环 with wdrange.find .text = key(i) '查找 .replacement.text = key(i) & iif(i = 1, cells(1, 1).value, cells(5, 2).value) '替换 .forward = true .wrap = wdfindcontinue .format = false .matchcase = false .matchwholeword = false .matchbyte = true .matchwildcards = false .matchsoundslike = false .matchallwordforms = false end with wdrange.find.execute replace:=wdreplaceall '全部替换 next wddoc.save '保存word wddoc.close '关闭word set wddoc = nothing application.screenupdating = true '开启屏幕刷新 end sub 经测试,已经达到楼主要求,请追加分数并采纳.呵呵