如何删除这样的空白段落？

sylun

附件是从word2003VBA帮助文件中复制粘贴过来并经简单处理而成文档的一部分。现有一问题：如何用查找替换法一次删除其中的空白段落（即第2段）？

附件还有个简单的宏，想查看该空白段落的字符构成情况，发现字符与看到的一样，也就是3个不同的字符（半角空格、不间断空格、段落标记）。但我用查找替换法最多只能选中该段落，而无法进行替换操作，只好全选中后再手工按删除键。一时想不出个所以然来，真的没有办法一步删除它吗？

VCms2oOW.rar (10.56 KB, 下载次数: 22)

2007-3-14 18:02 上传

点击文件名下载附件
如何删除这样的空白段落？

守柔

使用“^w^p”行吗？

sylun

用通配符[^32^s]{1,}^13查找时，没有找到匹配项。不用通配符，用Ctrl+V粘贴空白段落后加^p的方法，可查找到该空白段落，但无法替换；用代码^w^p的方法，点击查找全部时，显示找到1项（即该空白段落），但点击全部替换时，显示替换了7项，却偏偏没有替换掉那8个空格（即^w部分），除了那个段落标记不见了之外，不知还替换了什么？真是不可思议。

也许是该空白段落有问题，因后来发现将空白段落粘贴到新文档时，弹出了下图的警告，无法进行粘贴，且此点击工具栏的发送邮件按钮时word出错并自动关闭，但粘贴其他内容又不见异常。而早些时候进行同样的操作却没有发现此异常现象。不会是word不支持某种编辑功能多次重复操作（如word文档与其他文档间的复制粘贴）吧？

 

sylun

还有个VBA的问题弄不清，想请教：现文档的问题空白段落为第2段，设A为第2段落的range对象，如A.Characters.Count的值不等于A.End - A.Start的值，能否说明该段落不正常吗？

刚才才发现原来空白段落中还有三个control域，删除后可以粘贴，但删除变成不可撤消，并弹出相同的警告。

第一次注意到这个control域。原来该域是粘贴帮助文件时产生的，粘贴过来后原位置既有嵌入式控件图形也有这个域（控件域？），简单整理时是以查找^g的方式删除，但原来只是删除了图形，并未能删除其所在位置的control域，不像以手工点击删除方式能一起删除。

刚才从帮助文件重新粘贴后再测试，用手工或查找代码^g删除图形后可撤消删除，也没有弹出警告，删除后用代码（使用通配符）^g*^13不能选中空白段落；用^g查找全部（用通配符）可找到全部，但只选中最后一个图形；用*^13可以选中该空白段落，但代码变得没有代表性。

总算大概弄清这样的空白段落的底细。看来一步查找清除这样的空白段落的可能性更少了。

[此贴子已经被作者于2007-3-15 1:45:21编辑过]

守柔

QUOTE:

以下是引用sylun在2007-3-14 22:31:30的发言：

还有个VBA的问题弄不清，想请教：现文档的问题空白段落为第2段，设A为第2段落的range对象，如A.Characters.Count的值不等于A.End - A.Start的值，能否说明该段落不正常吗？

刚才才发现原来空白段落中还有三个control域，删除后可以粘贴，但删除变成不可撤消，并弹出相同的警告。

第一次注意到这个control域。原来该域是粘贴帮助文件时产生的，粘贴过来后原位置既有嵌入式控件图形也有这个域（控件域？），简单整理时是以查找^g的方式删除，但原来只是删除了图形，并未能删除其所在位置的control域，不像以手工点击删除方式能一起删除。

刚才从帮助文件重新粘贴后再测试，用手工或查找代码^g删除图形后可撤消删除，也没有弹出警告，删除后用代码（使用通配符）^g*^13不能选中空白段落；用^g查找全部（用通配符）可找到全部，但只选中最后一个图形；用*^13可以选中该空白段落，但代码变得没有代表性。

总算大概弄清这样的空白段落的底细。看来一步查找清除这样的空白段落的可能性更少了。

最近sylun兄的几个贴子都非常好,只是我这段时间比较忙,无法静下来好好琢磨一些问题。

我初步谈一下我的看法：

由帮助中复制过来的内容，如果直接粘贴，里面有很多链接、控件等，我们通常是使用选择性粘贴为无格式文本，但我知道你的初衷是既想删除无用的控件链接之类，又能保持段落的大致格式，从目前来说，一步法可能比较困难。

段落长度与字数的问题，如果是隐藏文字、隐藏域（如INDEX、RD）等也会出现这种情况。我知道另有一法，只是现在没有时间验证。

由于在粘贴过程中，源目标在WORD当前页代码中无法实现，故会不可撤消以及信息对话框。

明天星期六，我会好好研究一下sylun的这些问题，我们一起想办法。

sylun

谢谢老大关注。

确实，我不用无格式粘贴主要是想保留其中的大纲级别和表格等，这样会便于整理与学习。为更好理解帮助文件的有关内容，有时我会选辑一些相关内容整理成文档，以便不打开电脑也能学习。

提出本问题主要是当时没意识到空白段落里居然还隐藏着域，而当时又恰好没用Alt+F9查看。

现想尝试写这样一个特殊选择性粘贴的宏：只保留大纲级别和所有表格以及字体加粗、超链接文字颜色与下划线格式，其余内容为无格式粘贴；而对于表格，套用网格型样式，表格中的段落，除最后一列（不含最上面的单元格）为左对齐外，其余为居中对齐。最后将宏制成按钮，我想这样处理起来就方便多了。

守柔

我想sylun兄的出发点在于整理，而我使用查找与替换，一步法也无法到位，我根据sylun兄的意见，写了一个代码，请sylun兄测试一下。

'* ＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋＋
'* Created By SHOUROU@ExcelHome 2007-3-17 8:24:02
'仅测试于System: Windows NT Word: 11.0 Language: 2052
'№ 0182^The Code CopyIn [ThisDocument-ThisDocument]^'
'* －－－－－－－－－－－－－－－－－－－－－－－－－－－－－
Option Explicit
Sub Example()
    Dim i As Paragraph, myRange As Range, oTable As Table, oString As String
    Dim myFormatText As Range
    On Error Resume Next
    Application.ScreenUpdating = False
    With ActiveDocument
        '显示隐藏文本
        .ActiveWindow.View.ShowHiddenText = True
        '切断域链接
        .Content.Fields.Unlink
        '以下代码删除无效行以及最大限度保留原格式文本
        For Each i In .Paragraphs
            Set myRange = .Range(i.Range.Start, i.Range.End - 1)
            oString = Application.CleanString(myRange.Text)
            If myRange.Text <> oString Then myRange.Text = oString
            If Replace(oString, " ", "") = "" Then
                i.Range.Delete
            End If
        Next
        '以下代码规范表格样式和文本对齐方式
        For Each oTable In .Tables
            With oTable
                .Style = "网格型"
                .PreferredWidthType = wdPreferredWidthPercent
                .PreferredWidth = 100
                .Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
                .Range.Cells.VerticalAlignment = wdCellAlignVerticalCenter
                .Columns(1).Select
            End With
            Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
            Selection.Cells(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
        Next
        '以下代码规范文档中的中西文字体和段落1,以便于以后汇总和目录提取
        .Paragraphs(1).Style = "标题 3"
        .Content.Font.NameAscii = "Tahoma"
        .Content.Font.NameFarEast = "楷体_GB2312"
        .Content.Underline = False
        .Content.Font.Color = wdColorAutomatic
    End With
    Application.ScreenUpdating = True
End Sub
'----------------------

sylun

谢谢老大。

我的目的确实是为了整理，可能我在６楼没将意图讲清楚，导致老大可能误会我的意思了。我是想复制帮助文件相关内容后运行该宏即可完成粘贴及对粘贴部分文本的处理，而对文档原来的部分不作处理。

我试着写了如下测试代码，执行后基本可以处理，但还有些问题未能解决，如：没有保留原粘贴超带链接文本的颜色，有时执行时好像没有在活动文档进行，运行时间稍长，等等。不知如何修改简化才好。

Sub paste_helpfile()

'此宏用于整理从帮助文件粘贴来的文本
'复制帮助文件后运行本过程
'
    Dim myRange As Range, mytabl As Table, mypara As Paragraph, mycell As Cell
    Dim i As Integer, myfind As Variant, myreplace As Variant
    Dim starttime As Single, endtime As Single
    'starttime = Timer
    If Selection.Type <> wdSelectionIP Then
        MsgBox "当前所选内容不是插入点！", vbCritical
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Set myRange = Selection.Range
    Selection.Paste
    '设定查找替换的项目
    myfind = Array("^g", "[^32^s]{1,}^13", "^13{3,}", "<参阅*^13", "<(注意)^32", _
        "([A-z])^32([一-龥])", "([一-龥　])^32([A-z])", "全部显示", "全部隐藏")
    myreplace = Array("", "^p", "^p^p", "", "\1　", "\1\2", "\1\2", "", "")
    myRange.SetRange Start:=myRange.Start, End:=Selection.End
    With myRange
        .Select
        .Fields.Unlink    '取消域链接

        '执行查找替换

     For i = 0 To UBound(myfind)
            With .Find
                .ClearFormatting
                .MatchWildcards = True
                .Text = myfind(i)
                .Replacement.ClearFormatting
                .Replacement.Text = myreplace(i)
                .Execute Replace:=wdReplaceAll
            End With
        Next

　　　　'设置段落格式
        With .ParagraphFormat
            .LeftIndent = CentimetersToPoints(0)
            .RightIndent = CentimetersToPoints(0)
            .SpaceBefore = 0
            .SpaceBeforeAuto = False
            .SpaceAfter = 0
            .SpaceAfterAuto = False
            .LineSpacingRule = wdLineSpaceSingle
            .LineUnitBefore = 0
            .LineUnitAfter = 0
        End With
        '处理表格格式、宽度、及单元格内对齐
        If .Tables.Count > 0 Then
            For Each mytabl In .Tables
                With mytabl
                    .Style = "网格型"
                    .PreferredWidthType = wdPreferredWidthPercent
                    .PreferredWidth = 95
                    For Each mycell In .Range.Cells
                        If mycell.ColumnIndex = .Columns.Count _
                            And mycell.RowIndex > 1 Then
                            mycell.Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
                        Else
                            mycell.Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
                        End If
                    Next
                End With
            Next
        End If
        '设置段落字号大小
        For Each mypara In .Paragraphs
            If mypara.OutlineLevel = wdOutlineLevel1 Then
                mypara.Range.Font.Size = 15    '一级大纲级别段落为小三号
            ElseIf mypara.OutlineLevel = wdOutlineLevel2 Then
                mypara.Range.Font.Size = 14    '二级为四号
            Else
                mypara.Range.Font.Size = 12    '三级为小四
            End If
        Next
        Application.ScreenUpdating = True
        '将插入点置于新粘贴的文本之后
        .SetRange Start:=.End, End:=.End
        .Select
    End With
    'endtime = Timer
    'Debug.Print endtime - starttime
End Sub

[此贴子已经被作者于2007-3-17 11:24:02编辑过]