如何用VBA批量增加word中最后的表格内容。

沈熠 · 发表于 2022-7-28 15:49

最近公司体系升级，其中有一些文件需要在文件最后的表格上增加一行然后添加固定内容(表格行数不确定)，每个文件的内容不一样，有些文件中还含有其他表格，请问请问各位大神这种需求怎么通过VBA来实现批量修改，十分感谢~~

413191246se · 发表于 2022-7-28 20:04

* 请楼主将欲处理的文件备份到另一盘符后，将欲处理的文件放到除 C 盘的盘符中（文件不宜太多）。
* 如果代码复制到 VBE 中是乱码的话，可以先将代码粘贴到新建文档中，再全选、剪切到 VBE 中使用。
* 代码在Word2019中测试通过，每个文档都是自动保存退出的，不需要楼主另行修改。WPS也许例外。
* 请楼主先在 demo（演示）文件夹中处理确认无误后再进行正式处理，以免造成不必要的损失。
* 可以执行 a728 宏或 a7288 宏（是论坛两位高手老师分别写的代码，功能一样！）。

Sub a728_LoopFolder_xiaohualu()
Dim d, n&, m&, x&, mydir, dk, doc As Document, i&
Set d = CreateObject("Scripting.Dictionary")
d(SelectFolder728) = ""
Do While n < d.Count
dk = d.keys
mydir = Dir(dk(n), vbDirectory)
Do While mydir <> ""
If mydir <> "." And mydir <> ".." Then
If GetAttr(dk(n) & mydir) = vbDirectory Then
d(dk(n) & mydir & "") = ""
m = m + 1
Else
x = x + 1
If dk(n) & mydir Like "*.doc*" Then
Set doc = Documents.Open(FileName:=dk(n) & mydir)
DocProcess728
doc.Close SaveChanges:=wdSaveChanges
i = i + 1
End If
End If
End If
mydir = Dir
Loop
n = n + 1
Loop
Set d = Nothing
Set dk = Nothing
MsgBox "处理完毕！共 " & x & " 个文档！Word 文档 " & i & " 个！", 0 + 48
End Sub
Sub DocProcess728()
With ActiveDocument
If .Tables.Count >= 2 Then
With .Tables(2)
If .Columns.Count = 3 Then
.Rows(.Rows.Count).Select
Selection.InsertRowsBelow 1
With .Rows(.Rows.Count)
.Cells(1).Range.Text = "D/0"
.Cells(2).Range.Text = "2022.08.10"
.Cells(3).Range.Text = "组织架构调整，文件整体升版。"
End With
End If
End With
End If
End With
End Sub
Function SelectFolder728() As String
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show Then SelectFolder728 = .SelectedItems(1) & "" Else End
End With
If MsgBox("是否选择文件夹 """ & SelectFolder728 & """ ?", 4 + 16) = vbNo Then End
End Function
Sub a7288_LoopFolder_duquancai()
'循环遍历文件夹及子文件夹
Dim pPath$, f As Object, fd As Object, fso As Object, Stack$(), top&, n&, stxt$, doc As Document, x&
pPath = SelectFolder728
Set fso = CreateObject("Scripting.FileSystemObject")
top = 1
ReDim Stack(0 To top)
Do While top >= 1
For Each f In fso.getFolder(pPath).Files
n = n + 1
stxt = f.Path
If stxt Like "*.doc*" Then
Set doc = Documents.Open(FileName:=stxt)
DocProcess728 '单个文档处理
doc.Close SaveChanges:=wdSaveChanges
x = x + 1
End If
Next
For Each fd In fso.getFolder(pPath).subFolders
Stack(top) = fd.Path
top = top + 1
If top > UBound(Stack) Then ReDim Preserve Stack(0 To top)
Next
If top > 0 Then pPath = Stack(top - 1): top = top - 1
Loop
Set f = Nothing
Set fd = Nothing
Set fso = Nothing
MsgBox "处理完毕！共 " & n & " 个文档！Word 文档 " & x & " 个！", 0 + 48
End Sub

复制代码

沈熠 · 发表于 2022-7-29 08:42

413191246se 发表于 2022-7-28 20:04
* 请楼主将欲处理的文件备份到另一盘符后，将欲处理的文件放到除 C 盘的盘符中（文件不宜太多）。
* 如 ...

成功了！感谢大神再次出手相助~谢谢~~~~

		自动登录	找回密码
密码			免费注册

[求助] 如何用VBA批量增加word中最后的表格内容。