请教高手，如何用VBA删除文中的空白行，修改为如图所示的样子？

qiqi58 · 发表于 2023-8-13 09:38

本帖最后由 qiqi58 于 2023-8-13 11:58 编辑

这是原文档的样子：

WORD中很长的一个表格。
，现在需要将每个综合单价分析表分割成单独的一个表，并且结束后，加上签字盖章的文字，再插入分页符；大概步骤如下：

完成后的文档样式如图：

413191246se · 发表于 2023-8-13 13:39

* 楼主，请将代码复制后粘贴到空白文档中，全选，复制，再粘贴到 VBE 中，以防乱码。
* 不想要的格式之代码行可删除或屏蔽注释之。

Sub a0813_TableSplit_DeleteBlankLines()
'表格拆分/删除空行
Dim doc As Document, r As Row, t As Table
Set doc = ActiveDocument
'整表行高
With doc.Tables(1).Rows
.HeightRule = wdRowHeightAtLeast
.Height = CentimetersToPoints(0.9)
End With
'删除空行
For Each r In doc.Tables(1).Rows
If Len(Replace(Replace(r.Range, vbCr, ""), Chr(7), "")) = 0 Then r.Delete
Next
'表格拆分
For Each r In doc.Tables(1).Rows
With r.Range
If r.Range Like "表*分析表*" Then
With .Font
.NameFarEast = "黑体"
.NameAscii = "Times New Roman"
.Size = 16
.ColorIndex = wdRed
End With
r.Height = CentimetersToPoints(1.5)
r.Select
Selection.SplitTable
Selection.InsertBreak Type:=wdPageBreak
End If
End With
Next
'删除首表前字符
With doc.Range(0, doc.Tables(1).Range.Start)
.Select
Selection.MoveEnd 4, -1
Selection.Delete
End With
'循环遍历所有表格
For Each t In doc.Tables
'每表末行加粗
With t.Rows.Last.Range.Font
.Bold = True
.ColorIndex = wdPink
End With
'表末插入文字并缩进
doc.Range(t.Range.End, t.Range.End).InsertAfter Text:=vbCr & vbCr & "投标人签字盖章：" & vbCr & vbCr & "日期："
With doc.Range(t.Range.End, t.Range.End).Next(4, 1)
.Next(4, 1).ParagraphFormat.CharacterUnitFirstLineIndent = 14.5
.Next(4, 1).Next(4, 1).Next(4, 1).ParagraphFormat.CharacterUnitFirstLineIndent = 19.5
End With
Next
MsgBox "处理完毕！", 0 + 48
End Sub

复制代码

413191246se · 发表于 2023-8-13 17:46

本帖最后由 413191246se 于 2023-8-13 21:16 编辑

nonono......

qiqi58 · 发表于 2023-8-13 21:24

413191246se 发表于 2023-8-13 13:39
* 楼主，请将代码复制后粘贴到空白文档中，全选，复制，再粘贴到 VBE 中，以防乱码。
* 不想要的格式之代 ...

非常感谢大大的帮助，好人一生平安

qiqi58 · 发表于 2023-8-15 21:39

本帖最后由 qiqi58 于 2023-8-16 09:31 编辑

413191246se 发表于 2023-8-13 13:39
* 楼主，请将代码复制后粘贴到空白文档中，全选，复制，再粘贴到 VBE 中，以防乱码。
* 不想要的格式之代 ...

老师你好，那个签字栏文字代码我修改了就运行不了，想再麻烦你帮我修改一下好吗，文字格式如图所示：

万分感谢！

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

[求助] 请教高手，如何用VBA删除文中的空白行，修改为如图所示的样子？