空格的删除和文本的初步格式

weiyingde

在杜老师的指导和帮助，13907933959启发下，完成本程序，一键搞定段前、中、后所有多余空格（保留英文单词之间的一个半角空格），并对文本进行智能化格式。
对杜老师的指导和13907933959的帮助表示感谢。
代码如下：
Sub 空格的删除和文本的初步格式()
     On Error Resume Next
     With ActiveDocument.Content
         .Find.Execute "^w", , , , , , , , , "^32", 2 '此句为关键句，将大片空格转为半角空格，便于后期机动处理，比如英文之间保留空格等。
         .Find.Execute "([!A-Za-z])(^32)([!A-Za-z])", , , 1, , , , , , "\1\3", 2
         .Find.Execute "([A-Za-z])(^32)([!A-Za-z])", , , 1, , , , , , "\1\3", 2
         .Find.Execute "([!A-Za-z])(^32)([A-Za-z])", , , 1, , , , , , "\1\3", 2
         .Find.Execute "^11", , , 1, , , , , , "^p", 2 '
         .Find.Execute "(^32{1,})(*)(^13)", , , 1, , , , , , "\2\3", 2
         .Find.Execute "(*)(^13)(^32{1,})", , , 1, , , , , , "\1\2", 2
        With .Find
            With .Replacement.Font
                 .Name = "方正姚体"
                 .ColorIndex = wdPink
            End With
            .Execute "[A-Za-a]", , , 1, , , , , , "^&", 2
        End With
        With .Find
            With .Replacement.Font
                 .Name = "华文楷体"
                 .ColorIndex = wdBlue
            End With
            .Execute "[一-隝]", , , 1, , , , , , "^&", 2
        End With
     End With
     With ActiveDocument
       For i = 1 To .Paragraphs.Count
         .Paragraphs(i).Format.CharacterUnitFirstLineIndent = 2
       Next
     End With
End Sub

13907933959

前辈好！
感谢分享！敬佩您孜孜以求的精神！向您学习！

weiyingde

13907933959 发表于 2017-4-22 06:49
前辈好！
感谢分享！敬佩您孜孜以求的精神！向您学习！

谢谢关注和鼓励。
只是想把复杂的问题搞简单，方便大家，我就心满意足了。
奈何感悟较差，学艺不精，费时费力：一段在别人看来小菜一蝶的事情，在我这儿，往往千回百转，甚至山穷水尽。这段程序，从发帖到杀青，在你和杜老师的全程指导和帮助下，直到昨晚11点才告结束。
不求别的，一者爱好使然，二者博得大家一乐。
谢谢了。

13907933959

weiyingde 发表于 2017-4-22 07:36
谢谢关注和鼓励。
只是想把复杂的问题搞简单，方便大家，我就心满意足了。
奈何感悟较差，学艺不精，费 ...

前辈好！
我深有同感！真羡慕您！碰到问题最终总能自已解决，为您喝彩！为您加油！

413191246se

楼主 辛苦！——但我认为你这个宏远不是最终结果，并不完美。请看下面：
.
OK！半角空格删除了！
OK！不间断空格删除了！
OK！制表符删除了！
NO！空行未删除！
NO！段落首尾全角空格未删除！
*************请楼主在你的宏代码最后，加上我的《正文样式》宏，效果会好看一些；另外，字体应该设为全国通用的“宋仿楷黑”四种字体，不宜设为其它字体，最好是默认宋体才好……，请继续努力！
Sub 正文样式()
    Selection.ClearFormatting
    With Selection.Font
        .Name = "Times New Roman"
        .Size = 14
        .Kerning = 0
        .DisableCharacterSpaceGrid = True
    End With
    With Selection.ParagraphFormat
        .LineSpacing = LinesToPoints(1.25)
        .CharacterUnitFirstLineIndent = 2
        .AutoAdjustRightIndent = False
        .DisableLineHeightGrid = True
    End With
End Sub

413191246se

1. Sub 删除所有空格()
   
2.     Selection.WholeStory
   
3.     Selection.Find.Execute findtext:="^w", MatchWildcards:=False, Format:=False, ReplaceWith:="", Replace:=wdReplaceAll
   
4.     Selection.Find.Execute findtext:="　", MatchWildcards:=False, Format:=False, ReplaceWith:="", Replace:=wdReplaceAll
   
5. End Sub
   
6. Sub 删除段落首尾空格()
   
7.     Selection.WholeStory
   
8.     CommandBars.FindControl(ID:=122).Execute
   
9.     CommandBars.FindControl(ID:=123).Execute
   
10. End Sub
    
11. Sub 删除空行()
    
12.     Dim i As Paragraph
    
13.     For Each i In ActiveDocument.Paragraphs
    
14.         If Len(i.Range) = 1 Then i.Range.Delete
    
15.     Next
    
16. End Sub

复制代码

duquancai

建议：万能，通用，通吃  等词语尽量少出现，最起码不要不要用在贴 的标题，因为根本不可能有万能的代码。我一般看到这样的贴，一笑而过！

weiyingde

duquancai 发表于 2017-4-22 12:06
建议：万能，通用，通吃  等词语尽量少出现，最起码不要不要用在贴 的标题，因为根本不可能有万能的代码。 ...

万能，只不过是是一种目标，权当是一种激励吧，切莫当真。
只是，若有缺漏，或有完善方案代码，希望不吝赐教。

weiyingde

413191246se 发表于 2017-4-22 11:37
楼主 辛苦！——但我认为你这个宏远不是最终结果，并不完美。请看下面：
.
OK！半角空格删除了！

好的，我会加入进去的，谢谢你赐代码。

jiminyanyan

weiyingde 发表于 2017-4-22 13:37
好的，我会加入进去的，谢谢你赐代码。

我赞成杜老师观点，通吃代码很费时间精力，有时还不如手动效果好．
但楼主的研究精神可嘉！