一个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 ' 填写数据
这里报错,程序就断了。
以下是两个文件内容:
![](http://tiebapic.baidu.com/forum/w%3D580/sign=4f2a1036f0003af34dbadc68052bc619/2e80652762d0f703e87665e34efa513d2797c559.jpg?tbpicau=2024-09-12-05_8f8d6e6b14c412d4ed16d0f75bd92a89)
![](http://tiebapic.baidu.com/forum/w%3D580/sign=be13d0c170d3d539c13d0fcb0a86e927/b54cafec8a1363271529320cd78fa0ec09fac759.jpg?tbpicau=2024-09-12-05_9810d6d35bb6d567e4945be23fa27d5a)
求大神帮看看,错在哪,咋改
感激不尽,好人一生平安
以下是代码:
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 ' 填写数据
这里报错,程序就断了。
以下是两个文件内容:
![](http://tiebapic.baidu.com/forum/w%3D580/sign=4f2a1036f0003af34dbadc68052bc619/2e80652762d0f703e87665e34efa513d2797c559.jpg?tbpicau=2024-09-12-05_8f8d6e6b14c412d4ed16d0f75bd92a89)
![](http://tiebapic.baidu.com/forum/w%3D580/sign=be13d0c170d3d539c13d0fcb0a86e927/b54cafec8a1363271529320cd78fa0ec09fac759.jpg?tbpicau=2024-09-12-05_9810d6d35bb6d567e4945be23fa27d5a)
求大神帮看看,错在哪,咋改
![](http://tb2.bdstatic.com/tb/editor/images/face/i_f19.png?t=20140803)