求教：如何用VBA实现“删除段首空格”...

hemd

运行到range()处报错，子过程或函数未定义。

banjinjiu

守柔 发表于 2004-7-4 17:07
请参考以下代码：Sub ReplSpace()
Dim i As Paragraph, MyStart As Long
Application.ScreenUpdating = F ...

1. Sub ReplSpace()
   
2. '删除段首空格
   
3. Dim i As Paragraph, MyStart As Long
   
4. Application.ScreenUpdating = False
   
5. For Each i In ActiveDocument.Paragraphs
   
6. MyStart = i.Range.Start
   
7. Range(Start:=MyStart, End:=MyStart).Select
   
8. Selection.EndKey Unit:=wdLine, Extend:=wdExtend
   
9. With Selection
   
10. .Find.ClearFormatting
    
11. .Find.Replacement.ClearFormatting
    
12. With .Find
    
13. .Text = " "
    
14. .Replacement.Text = "" '查找空格
    
15. .Forward = True
    
16. .MatchByte = False '不区分半角全角
    
17. End With
    
18. .Find.Execute Replace:=wdReplaceAll
    
19. End With
    
20. Next
    
21. Application.ScreenUpdating = True
    
22. End Sub

复制代码

首柔的代码删除了所有的空格，而不是段落首空格，需要修改。

1. Sub InsertSpace()
   
2. '插入段首空格
   
3. Dim i As Paragraph
   
4. For Each i In ActiveDocument.Paragraphs
   
5. i.Range.InsertBefore "　　" '注意此处是两个全角空格,请在全角下输入此处.
   
6. Next
   
7. End Sub

复制代码

有时间学习修改。

有杕之杜

hemd 发表于 2010-4-6 11:09
运行到range()处报错，子过程或函数未定义。

把range替换成 ActiveDocument.Range

小声说话666

可以试下这个代码：
ActiveDocument.Content.Find.Execute FindText:="^p([ 　]{1,})", MatchWildcards:=True, replacewith:="^p", Replace:=wdReplaceAll
上述代码在WPS中测试通过，WORD中因使用通配符反而出错。

另求各位大神指点在WPS中如何用代码替换不间断空格(\u00A0)。

413191246se

"不间断空格"用代码表示为：^s，建议 楼主 想玩 VBA，最好用 Word。

有杕之杜

Sub 删除段首空格()

Dim i As Integer

For i = 1 To ActiveDocument.Paragraphs.Count

   ActiveDocument.Paragraphs(i).Range.Select

    Call DelSpacesAheadPara

    Call 设置段落格式之缩进(0, 0, 0)

    Debug.Print ActiveDocument.Paragraphs(i).OutlineLevel, ActiveDocument.Paragraphs(i).Range.Font.Name

Next i

End Sub

Sub 设置段落格式()

Dim i As Integer

Dim flag As Boolean

Application.ScreenUpdating = False

For i = 1 To ActiveDocument.Paragraphs.Count

    Debug.Print ActiveDocument.Paragraphs(i).Range.Text

    If ActiveDocument.Paragraphs(i).Range.Text = "参考文献^p" Then

       Exit For '仅设置参考文献以前的段落

    End If

    '正文宋体的段落 颜色和缩进设置 蓝色

    If ActiveDocument.Paragraphs(i).OutlineLevel = wdOutlineLevelBodyText And ActiveDocument.Paragraphs(i).Range.Font.Name = "宋体" Then

       ActiveDocument.Paragraphs(i).Range.Select

      ActiveDocument.Paragraphs(i).Range.Font.ColorIndex = wdBlue

       Call 设置段落格式之缩进(0, 0, 2)

    End If

    '楷体_GB2312的段落颜色和缩进设置 红色

    If ActiveDocument.Paragraphs(i).OutlineLevel = wdOutlineLevelBodyText And ActiveDocument.Paragraphs(i).Range.Font.Name = "楷体_GB2312" Then

       ActiveDocument.Paragraphs(i).Range.Select

      ActiveDocument.Paragraphs(i).Range.Font.ColorIndex = wdRed

       Call 设置段落格式之缩进(2, 0, 2)

    End If

    '非单一字体的段落 颜色和缩进设置 粉色

    If ActiveDocument.Paragraphs(i).OutlineLevel = wdOutlineLevelBodyText And ActiveDocument.Paragraphs(i).Range.Font.Name = "" Then

       ActiveDocument.Paragraphs(i).Range.Select

      ActiveDocument.Paragraphs(i).Range.Font.ColorIndex = wdPink

       Call 设置段落格式之缩进(0, 0, 2)

    End If

Next i

Application.ScreenUpdating = True

End Sub

Sub 设置段落格式之缩进(LIndent, RIndent, FIndent)

    With Selection.ParagraphFormat

       .CharacterUnitLeftIndent = LIndent

       .CharacterUnitRightIndent = RIndent

       .CharacterUnitFirstLineIndent = FIndent

       .LeftIndent = CentimetersToPoints(LIndent)

       .RightIndent = CentimetersToPoints(RIndent)

       .FirstLineIndent = CentimetersToPoints(FIndent)

    End With

End Sub

Private Sub DelSpacesAheadPara()
'删除段首空格



    If Len(Selection.Text) < 2 Then Exit Sub

    On Error Resume Next



    Selection.MoveStart unit:=wdCharacter, Count:=-1   '向前移动一个字符，包含前回车符

    Call FindReplaceChar(Selection, "^p^w", "^p", wdFindStop, bByte:=False)

    If Selection.Start > ActiveDocument.Range.Start Then _

       Selection.MoveStart unit:=wdCharacter, Count:=1 '非起始位置

    End if
End Sub

Private Sub FindReplaceChar(ByVal objSel As Object, ByVal strFind As String, _

    ByVal strReplace As String, ByVal FindWrap As Integer, _

    Optional ByVal bWild As Boolean = False, Optional ByVal bByte As Boolean = True)

'执行查找替换操作



   objSel.Find.ClearFormatting

   objSel.Find.Replacement.ClearFormatting

    With objSel.Find

       .Text = strFind

       .Replacement.Text = strReplace

       .Forward = True

       .Wrap = FindWrap  'wdFindStop:停止,替换选定部分,若没选中,则默认替换至文档末尾

       .Format = False

       .MatchCase = False

       .MatchWholeWord = False

       .MatchByte = bByte

       .CorrectHangulEndings = False

       .MatchWildcards = bWild

       .MatchSoundsLike = False

       .MatchAllWordForms = False

    End With

    objSel.Find.Execute Replace:=wdReplaceAll

   ActiveDocument.Activate

   

End Sub
以上代码来自http://blog.sina.com.cn/s/blog_4 ... .html#commonComment并经过验证可用。

有杕之杜

1. Sub 删除段首空格()
   
2. 
   
3. Dim i As Integer
   
4. 
   
5. For i = 1 To ActiveDocument.Paragraphs.Count
   
6. 
   
7.    ActiveDocument.Paragraphs(i).Range.Select
   
8. 
   
9.     Call DelSpacesAheadPara
   
10. 
    
11.     Call 设置段落格式之缩进(0, 0, 0)
    
12. 
    
13.     Debug.Print ActiveDocument.Paragraphs(i).OutlineLevel, ActiveDocument.Paragraphs(i).Range.Font.Name
    
14. 
    
15. Next i
    
16. 
    
17. End Sub
    
18. 
    
19. Sub 设置段落格式()
    
20. 
    
21. Dim i As Integer
    
22. 
    
23. Dim flag As Boolean
    
24. 
    
25. Application.ScreenUpdating = False
    
26. 
    
27. For i = 1 To ActiveDocument.Paragraphs.Count
    
28. 
    
29.     Debug.Print ActiveDocument.Paragraphs(i).Range.Text
    
30. 
    
31.     If ActiveDocument.Paragraphs(i).Range.Text = "参考文献^p" Then
    
32. 
    
33.        Exit For '仅设置参考文献以前的段落
    
34. 
    
35.     End If
    
36. 
    
37.     '正文宋体的段落 颜色和缩进设置 蓝色
    
38. 
    
39.     If ActiveDocument.Paragraphs(i).OutlineLevel = wdOutlineLevelBodyText And ActiveDocument.Paragraphs(i).Range.Font.Name = "宋体" Then
    
40. 
    
41.        ActiveDocument.Paragraphs(i).Range.Select
    
42. 
    
43.       ActiveDocument.Paragraphs(i).Range.Font.ColorIndex = wdBlue
    
44. 
    
45.        Call 设置段落格式之缩进(0, 0, 2)
    
46. 
    
47.     End If
    
48. 
    
49.     '楷体_GB2312的段落颜色和缩进设置 红色
    
50. 
    
51.     If ActiveDocument.Paragraphs(i).OutlineLevel = wdOutlineLevelBodyText And ActiveDocument.Paragraphs(i).Range.Font.Name = "楷体_GB2312" Then
    
52. 
    
53.        ActiveDocument.Paragraphs(i).Range.Select
    
54. 
    
55.       ActiveDocument.Paragraphs(i).Range.Font.ColorIndex = wdRed
    
56. 
    
57.        Call 设置段落格式之缩进(2, 0, 2)
    
58. 
    
59.     End If
    
60. 
    
61.     '非单一字体的段落 颜色和缩进设置 粉色
    
62. 
    
63.     If ActiveDocument.Paragraphs(i).OutlineLevel = wdOutlineLevelBodyText And ActiveDocument.Paragraphs(i).Range.Font.Name = "" Then
    
64. 
    
65.        ActiveDocument.Paragraphs(i).Range.Select
    
66. 
    
67.       ActiveDocument.Paragraphs(i).Range.Font.ColorIndex = wdPink
    
68. 
    
69.        Call 设置段落格式之缩进(0, 0, 2)
    
70. 
    
71.     End If
    
72. 
    
73. Next i
    
74. 
    
75. Application.ScreenUpdating = True
    
76. 
    
77. End Sub
    
78. 
    
79. Sub 设置段落格式之缩进(LIndent, RIndent, FIndent)
    
80. 
    
81.     With Selection.ParagraphFormat
    
82. 
    
83.        .CharacterUnitLeftIndent = LIndent
    
84. 
    
85.        .CharacterUnitRightIndent = RIndent
    
86. 
    
87.        .CharacterUnitFirstLineIndent = FIndent
    
88. 
    
89.        .LeftIndent = CentimetersToPoints(LIndent)
    
90. 
    
91.        .RightIndent = CentimetersToPoints(RIndent)
    
92. 
    
93.        .FirstLineIndent = CentimetersToPoints(FIndent)
    
94. 
    
95.     End With
    
96. 
    
97. End Sub
    
98. 
    
99. Private Sub DelSpacesAheadPara()
    
100. '删除段首空格
     
101. 
     
102. 
     
103. 
     
104.     If Len(Selection.Text) < 2 Then Exit Sub
     
105. 
     
106.     On Error Resume Next
     
107. 
     
108. 
     
109. 
     
110.     Selection.MoveStart unit:=wdCharacter, Count:=-1   '向前移动一个字符，包含前回车符
     
111. 
     
112.     Call FindReplaceChar(Selection, "^p^w", "^p", wdFindStop, bByte:=False)
     
113. 
     
114.     If Selection.Start > ActiveDocument.Range.Start Then _
     
115. 
     
116.        Selection.MoveStart unit:=wdCharacter, Count:=1 '非起始位置
     
117. 
     
118.      End if
     
119. 
     
120. End Sub
     
121. 
     
122. Private Sub FindReplaceChar(ByVal objSel As Object, ByVal strFind As String, _
     
123. 
     
124.     ByVal strReplace As String, ByVal FindWrap As Integer, _
     
125. 
     
126.     Optional ByVal bWild As Boolean = False, Optional ByVal bByte As Boolean = True)
     
127. 
     
128. '执行查找替换操作
     
129. 
     
130. 
     
131. 
     
132.    objSel.Find.ClearFormatting
     
133. 
     
134.    objSel.Find.Replacement.ClearFormatting
     
135. 
     
136.     With objSel.Find
     
137. 
     
138.        .Text = strFind
     
139. 
     
140.        .Replacement.Text = strReplace
     
141. 
     
142.        .Forward = True
     
143. 
     
144.        .Wrap = FindWrap  'wdFindStop:停止,替换选定部分,若没选中,则默认替换至文档末尾
     
145. 
     
146.        .Format = False
     
147. 
     
148.        .MatchCase = False
     
149. 
     
150.        .MatchWholeWord = False
     
151. 
     
152.        .MatchByte = bByte
     
153. 
     
154.        .CorrectHangulEndings = False
     
155. 
     
156.        .MatchWildcards = bWild
     
157. 
     
158.        .MatchSoundsLike = False
     
159. 
     
160.        .MatchAllWordForms = False
     
161. 
     
162.     End With
     
163. 
     
164.     objSel.Find.Execute Replace:=wdReplaceAll
     
165. 
     
166.    ActiveDocument.Activate
     
167. 
     
168.    
     
169. 
     
170. End Sub

复制代码

以上代码来自http://blog.sina.com.cn/s/blog_4 ... .html#commonComment