WORD自动编号替换手动编号（只转换选中文本的方法？）

sylun

隔行如隔山，并不是表达清不清楚的问题。
如要将不连续的多个选定区域的段落自动编号转换成文本，可试试如下代码：
Sub MyConvertNumbersToText()
Options.DefaultHighlightColorIndex = wdYellow
Application.ScreenUpdating = False
With Selection.Find
    If .Parent.Type = wdSelectionIP Then
        MsgBox "请选定内容!"
        Exit Sub
    End If
    .ClearFormatting
    .Format = False
    .Replacement.Highlight = True
    .Forward = True
    .MatchWildcards = False
    .Execute "^?", replacewith:="^&", Replace:=wdReplaceAll
    .Parent.EndKey wdStory
    .Format = True
    .Highlight = True
    .Replacement.Highlight = False
    .Forward = False
    Do While .Execute("", Replace:=wdReplaceOne)
        .Parent.Range.ListFormat.ConvertNumbersToText
        .Parent.Collapse wdCollapseStart
    Loop
End With
Application.ScreenUpdating = True
End Sub

Elaine_cai

非常谢谢sylun！！！
今天用各种文档测试了这个宏，大部分情况下表现非常卓越！实在厉害！

不过有时在大文件中替换后会出现很奇怪的现象（每个字都重复一次）：
（1）        杜杜绝绝人人身身伤伤害害
EExxtteerrmmiinnaattiinngg  hhuummaann  bbooddyy  iinnjjuurryy
（2）        杜杜绝绝人人身身伤伤亡亡
EExxtteerrmmiinnaattiinngg  hhuummaann  ccaassuuaallttyy
（3）        杜杜绝绝重重大大交交通通、、火火灾灾事事故故和和环环境境污污染染事事故故
EExxtteerrmmiinnaattiinngg  mmaajjoorr  aacccciiddeennttss  ooff  ttrraannssppoorrttaattiioonn,,  ffiirree  aanndd  eennvviirroonnmmeenntt  ppoolllluuttiioonn
（4）        杜杜绝绝重重大大设设备备损损坏坏事事故故
EExxtteerrmmiinnaattiinngg  mmaajjoorr  aacccciiddeennttss  ooff  eeqquuiippmmeenntt  ddaammaaggee
（5）        杜杜绝绝供供电电系系统统质质量量引引起起的的责责任任故故障障
Exterminating responsibility fault caused by power supply system quality

小文件就没这个问题。而且出现问题的段落也不是每次替换都会变成这样，不知道是什么原因呢？

另外，宏本身采用了highlight功能，所以选中的文字如果本来就有高亮，在宏处理过后就没有高亮了。

Elaine_cai

网络错误，重复发帖。

tangqingfu

能否请楼主把文档传上来看看，也好让大家也学习学习！

sylun

因为是处理不连续的多个选定区域内容，程序需要用特殊字符格式标记作过渡，然后再按逆序方式依次对该特殊标记区域进行转换，并删除该特殊标记。因此，特殊格式标记须是原文档中没有的，原程序用了突出显示标记，也可用字符颜色等。
至于所提到的奇怪现象，我也不清楚是什么原因所致，看来也不便测试。

Elaine_cai

谢谢sylun的关注！！！

抱歉！这几天一直在加班，所以现在才回复。
由于文件内容的关系，我会先对内容做适当删减后传上来。

blackeyescn

这个问题，最好的方法是用模版来解决！将要编号的项目都设为样式，然后统一使用多级符号

[ 本帖最后由 blackeyescn 于 2009-4-19 14:39 编辑 ]

ltj6407

我刚试了这个，很好用
Sub test()
    Dim oRange As Range
    On Error Resume Next
    Application.ScreenUpdating = False
    If Selection.Type = wdSelectionIP Then
        Set oRange = ActiveDocument.Content
    Else
        Set oRange = Selection.Range
    End If
    oRange.ListFormat.ConvertNumbersToText
    Application.ScreenUpdating = True
End Sub

geryjun

做个记号，学习了。

liuye444

ltj6407 发表于 2011-3-16 17:32
我刚试了这个，很好用
Sub test()
    Dim oRange As Range

确实挺好用的。