邮件合并后，用 VBA 删除分节符

413191246se

    有些朋友在进行邮件合并时，由于域文件是表格形式的，合并后，合并结果文件中，每个表格后面直接就是分节符，用正常的“查找与替换”功能不能删除分节符！
    前几天我提供了网上别人介绍的一个方法：查找^b，再勾选“突出显示所有在该范围显示的项目“一项，再关闭查找对话框，按删除键（DELETE）删除分节符，这样，虽然能删除分节符，但表格之间都是连在一起了，未完全达到目的。
    我试着用 VBA 编程的方法，达到了删除分节符，并且使各个表格之间有一个空行（回车符）间隔，这样，就可以具体地编辑合并结果文档了（如：分栏等，表格之间的空行可以先选中一个，再右键选择：选择相似的文本）。

*** 删除分节符（邮件合并后，删除表格后的分节符，使之有一个空行相隔）：

Sub 删除分节符()
'取消网格
    If Selection.Type = wdSelectionIP Then Selection.WholeStory
    With Selection.Font
        .Kerning = 0
        .DisableCharacterSpaceGrid = True
    End With
    With Selection.ParagraphFormat
        .AutoAdjustRightIndent = False
        .DisableLineHeightGrid = True
    End With

'表格后加回车
    Dim t As Table
    For Each t In ActiveDocument.Tables
        t.Select
        Selection.MoveRight Unit:=wdCharacter, Count:=1
        Selection.TypeParagraph
    Next

'删除分节符
    Dim i As Paragraph
    For Each i In ActiveDocument.Paragraphs
        If i.Range Like "*" & Chr(12) Then i.Range.Characters.Last.Delete
    Next

'分3栏
    Selection.WholeStory
    If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
        ActiveWindow.Panes(2).Close
    End If
    If ActiveWindow.ActivePane.View.Type <> wdPrintView Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    End If
    With Selection.PageSetup.TextColumns
        .SetCount NumColumns:=3
        .EvenlySpaced = True
        .LineBetween = False
        .Width = CentimetersToPoints(7.57)
        .Spacing = CentimetersToPoints(0.99)
    End With
    Selection.HomeKey Unit:=wdStory

    MsgBox "处理完毕！"
End Sub

psystyle

留个记号，，，，

m_n_j001

学习，谢谢{:soso_e179:}

wjc_119

谢谢了，这几天在急用啊

wjc_119

{:soso_e154:}谢谢啊，如果在贵州，一定请你吃饭啊！！！！！

413191246se

各位朋友，不必客气，虽然编程水平较低，但如果能对各位有所帮助，我也很高兴！——请各位下载我的 Word 2003 通用模板（预览版），认真读一读使用帮助，有不少功能哩，对日常简单排版很有好处。

yingbinliu

执行结果不对啊

413191246se

楼上朋友，请试试下面的代码：（本帖最初代码可能不适合）

1. Sub 删除分节符_表格邮件合并()
   
2.     Dim t As Table
   
3.     For Each t In ActiveDocument.Tables
   
4.         t.Range.Next.InsertParagraphBefore
   
5.     Next
   
6.     Dim i As Paragraph
   
7.     For Each i In ActiveDocument.Paragraphs
   
8.         If i.Range Like "*" & Chr(12) Then i.Range.Characters.Last.Delete
   
9.     Next
   
10. End Sub

复制代码