一个VBA程序:在EXCEL工作表“作业令填报”中将B列至S列单元格中的数据以文本的格式依次填入A列文件名的word文档中的[B]、[C]、[D]、[E]、[F]、[G]、[H]、[I]、[J]、[K]、[L]、[M]、[N]、[O]、[P]、[Q]、[R]、[S]书签处,发现一处填写一处,依次填写完成所有文件;EXCEL文件和word文档在同一个文件夹内。
以下是代码:
Sub FillWordBookmarksFromExcel()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("作业令填报")
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' 确定A列的最后一行
Dim wordApp As Object
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = True ' 如果需要查看Word操作过程,则设置为True
Dim filePath As String
Dim docPath As String
Dim doc As Object
Dim cellValue As String
Dim i As Long, j As Long
Dim bookmarkName As String
' 遍历Excel中的每一行
For i = 2 To lastRow ' 假设第一行是标题行
cellValue = ws.Cells(i, 1).Value ' 获取A列的文件名
filePath = ThisWorkbook.Path & "\" & cellValue & ".docx" ' 构建Word文档的完整路径
' 检查文件是否存在
If Dir(filePath) <> "" Then
Set doc = wordApp.Documents.Open(filePath) ' 打开Word文档
' 从B列到S列遍历
For j = 2 To 19
bookmarkName = "[" & Chr(j + 64) & "]" ' 生成书签名称
' 检查Word文档中是否存在该书签
If doc.Bookmarks.Exists(bookmarkName) Then
doc.Bookmarks(bookmarkName).Range.Text = ws.Cells(i, j).Value ' 填写数据
End If
Next j
doc.Save ' 保存文档
doc.Close ' 关闭文档
Set doc = Nothing ' 清除对象引用
Else
MsgBox "未找到Word文档: " & filePath, vbExclamation
End If
Next i
wordApp.Quit ' 退出Word应用程序
Set wordApp = Nothing ' 清除对象引用
MsgBox "所有Word文档已更新完成!", vbInformation
End Sub
循环到
If doc.Bookmarks.Exists(bookmarkName) Then
doc.Bookmarks(bookmarkName).Range.Text = ws.Cells(i, j).Value ' 填写数据
这里报错,程序就断了。
以下是两个文件内容:
求大神帮看看,错在哪,咋改感激不尽,好人一生平安
以下是代码:
Sub FillWordBookmarksFromExcel()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("作业令填报")
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ' 确定A列的最后一行
Dim wordApp As Object
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = True ' 如果需要查看Word操作过程,则设置为True
Dim filePath As String
Dim docPath As String
Dim doc As Object
Dim cellValue As String
Dim i As Long, j As Long
Dim bookmarkName As String
' 遍历Excel中的每一行
For i = 2 To lastRow ' 假设第一行是标题行
cellValue = ws.Cells(i, 1).Value ' 获取A列的文件名
filePath = ThisWorkbook.Path & "\" & cellValue & ".docx" ' 构建Word文档的完整路径
' 检查文件是否存在
If Dir(filePath) <> "" Then
Set doc = wordApp.Documents.Open(filePath) ' 打开Word文档
' 从B列到S列遍历
For j = 2 To 19
bookmarkName = "[" & Chr(j + 64) & "]" ' 生成书签名称
' 检查Word文档中是否存在该书签
If doc.Bookmarks.Exists(bookmarkName) Then
doc.Bookmarks(bookmarkName).Range.Text = ws.Cells(i, j).Value ' 填写数据
End If
Next j
doc.Save ' 保存文档
doc.Close ' 关闭文档
Set doc = Nothing ' 清除对象引用
Else
MsgBox "未找到Word文档: " & filePath, vbExclamation
End If
Next i
wordApp.Quit ' 退出Word应用程序
Set wordApp = Nothing ' 清除对象引用
MsgBox "所有Word文档已更新完成!", vbInformation
End Sub
循环到
If doc.Bookmarks.Exists(bookmarkName) Then
doc.Bookmarks(bookmarkName).Range.Text = ws.Cells(i, j).Value ' 填写数据
这里报错,程序就断了。
以下是两个文件内容:
求大神帮看看,错在哪,咋改感激不尽,好人一生平安