|
我们每个月要写经济运行分析报告Word版本,里面涉及几百个数据,一个个敲上去太痛苦。
简单说,就是Excel里做好所需数据,全部位于某一列(有200-300个数据),然后替换Word模板中的预制文本(如C1、C2....C200...)
网上找了个代码,结果运行达不到效果。请大神帮助修改完善。
Sub ReplaceValuesInWordTemplate()
Dim excelWorksheet As Worksheet
Dim wordApp As Object
Dim wordDoc As Object
Dim templatePath As String
Dim i As Integer
Dim cValues(1 To 300) As Variant
' 获取 Excel 活动工作表
Set excelWorksheet = ActiveSheet
' 从第一列开始将数值赋值给变量
For i = 1 To 300
cValues(i) = excelWorksheet.Cells(Application.ActiveCell.Row, i).Value
Next i
' 获取 Word 模板路径
templatePath = GetWordTemplatePath()
If templatePath = "" Then
MsgBox "未选择 Word 模板"
Exit Sub
End If
' 创建 Word 应用程序对象
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = False
' 打开 Word 模板
Set wordDoc = wordApp.Documents.Open(templatePath)
' 替换 Word 模板中的预置文本内容
For i = 1 To 300
With wordApp.Selection.Find
.Text = "C" & i ' 修改为您想要的预置文本形式,例如 "预置文本" & i
.Replacement.Text = CStr(cValues(i))
.Execute Replace:=2
End With
Next i
' 选择生成的 Word 文件的保存路径
savePath = Application.GetSaveAsFilename(FileFilter:="Word Documents (*.docx), *.docx")
If savePath = "False" Then
MsgBox "未选择保存路径"
Exit Sub
End If
' 保存并另存为新的 Word 文件
wordDoc.SaveAs2 savePath
' 关闭并退出 Word 应用程序
wordDoc.Close SaveChanges:=False
wordApp.Quit
' 释放对象变量
Set wordDoc = Nothing
Set wordApp = Nothing
MsgBox "生成的 Word 文件保存成功"
End Sub
Function GetWordTemplatePath() As String
Dim fileDialog As Object
Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
With fileDialog
.Title = "选择 Word 模板"
.Filters.Clear
.Filters.Add "Word Documents", "*.docx"
.AllowMultiSelect = False
If .Show = -1 Then
GetWordTemplatePath = .SelectedItems(1)
Else
GetWordTemplatePath = ""
End If
End With
Set fileDialog = Nothing
End Function
|
|