现在因公司里面的要求，需要做一个小项目，就是让用户能够在习惯的Word表格里面填写信息，保存后信息自动保存在excel里面，也就是excel与Word之间的信息互转问题。
现在面临的问题是，用excel的VBA打开供用户填写的有着空白表格Word后，Word无法得到excel里面的比如填报人姓名对应的单元格的信息。
比如说，在一个名为“总工月报表.xlsm”里面，我给加了一个控件按钮，点击之后会打开路径为“F：\总工月报表.docm”的有着空白表格的Word文档，"总工月报表.xlsm"的C2单元格的值是填报人的姓名，怎么才能让这个路径为“F：\总工月报表.docm”的有着空白表格的Word文档在打开时，其中的表格的第一行第二列的位置自动写入"总工月报表.xlsm"的C2单元格的值，即填报人的姓名呢？
还望高手不吝赐教
联系方式：cjt92cjt92@163.com
VBA Word Excel 数据交互
答案:2 悬赏:80 手机版
解决时间 2021-03-05 20:35
- 提问者网友：末路
- 2021-03-05 03:18
最佳答案
- 五星知识达人网友：几近狂妄
- 2021-03-05 03:40
我是使用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
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
全部回答
- 1楼网友：春色三分
- 2021-03-05 04:57
将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
经测试,已经达到楼主要求,请追加分数并采纳.呵呵
我要举报
如以上回答内容为低俗、色情、不良、暴力、侵权、涉及违法等信息，可以点下面链接进行举报！
点此我要举报以上问答信息
大家都在看
推荐资讯