|
从论坛搜罗“热浪”的帖子“excel数据定入word”,在我这就遇到问题了,求助!自动化(Automation)错误,对象库未注册,也搜了相关的一些贴子操作,还是不行,请教大神帮忙一下,代码如下,运行到 with word对象就不行了,提示对象库未注册。
引用字典我也打钩了,Microsoft Scripting Runtime这个也选择了,还是问题依旧。
热浪的代码经过大家测试应该没问题,是我的office有问题还是系统有问题?我的是office 2013版本。
-----代码如下----
Private Sub CommandButton输出通知到Word文件_Click()
Dim Word对象 As Word.Application, 当前路径, 导出文件名, 导出路径文件名, i, j
Dim Str1, Str2
当前路径 = ThisWorkbook.Path
最后行号 = Sheets("数据").Range("B65536").End(xlUp).Row
判断 = 0
For i = 2 To 最后行号
导出文件名 = "授课通知"
FileCopy 当前路径 & "\授课通知(模板).doc", 当前路径 & "\" & 导出文件名 & "(" & Sheets("数据").Range("B" & i) & ").doc"
导出路径文件名 = 当前路径 & "\" & 导出文件名 & "(" & Sheets("数据").Range("B" & i) & ").doc"
With Word对象【就在这里运行不下去了】
.Documents.Open 导出路径文件名
.Visible = False
For j = 1 To 5 '填写文字数据
Str1 = "数据" & Format(j, "000")
Str2 = Sheets("数据").Cells(i, j + 1)
.Selection.HomeKey Unit:=wdStory '光标置于文件首
If .Selection.Find.Execute(Str1) Then '查找到指定字符串
.Selection.Font.Color = wdColorAutomatic '字符为自动颜色
.Selection.Text = Str2 '替换字符串
End If
Next j
For j = 1 To 3 '填写表格数据
.ActiveDocument.Tables(1).Cell(2, j).Range = Sheets("数据").Cells(i, j + 6)
.ActiveDocument.Tables(1).Cell(4, j).Range = Sheets("数据").Cells(i, j + 9)
Next j
.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader '设置位置在页眉
Str1 = "数据006"
Str2 = Sheets("数据2").Cells(2, 2)
.Selection.HomeKey Unit:=wdStory '光标置于文件首
If .Selection.Find.Execute(Str1) Then '查找到指定字符串
.Selection.Font.Color = wdColorAutomatic '字符为自动颜色
.Selection.Text = Str2 '替换字符串
End If
.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter '设置位置在页脚
Str1 = "数据007"
Str2 = Sheets("数据2").Cells(2, 1)
.Selection.HomeKey Unit:=wdStory '光标置于文件首
If .Selection.Find.Execute(Str1) Then '查找到指定字符串
.Selection.Font.Color = wdColorAutomatic '字符为自动颜色
.Selection.Text = Str2 '替换字符串
End If
End With
Word对象.Documents.Save
Word对象.Quit
Set Word对象 = Nothing
Next i
If 判断 = 0 Then
i = MsgBox("已输出到 Word 文件!", 0 + 48 + 256 + 0, "提示:")
End If
End Sub
|
-
-
|