增加空行与删除空行word vba

时　间:2012-05-21 10:46:30
作　者:欢乐小爪   ID：20149  城市：杭州
摘　要:WORD  增加空行,删除空行
正　文:

Sub 每行增加一行空行()
Dim l As String
Dim LineCount As Integer
Dim i As Integer
Dim RangeStart As Long
Dim RangeEnd As Long
Dim MyRange As Range
On Error Resume Next
Application.ScreenUpdating = False
CommandBars("Word Count").Visible = True
CommandBars("Word Count").Controls(2).Execute
l = CommandBars("Word Count").Controls(1).List(6)
CommandBars("Word Count").Visible = False
Application.ScreenUpdating = True

LineCount = Int(Mid(l, 1, Len(l) - 1))
With ActiveDocument
For i = LineCount To 1 Step -1
If .Content.End <= 1 Then Exit Sub
RangeStart = .GoTo(wdGoToLine, , i).Start
RangeEnd = VBA.IIf(i = LineCount, .Content.End, .GoTo(wdGoToLine, , i + 1).Start)
Set MyRange = .Range(RangeStart, RangeEnd)
'kk = Right(Replace(MyRange, " ", ""), 5)
MyRange.Select
Selection.MoveLeft
   Selection.TypeParagraph

Next
End With
End Sub
 
Sub 空行删除()
Dim l As String
Dim LineCount As Integer
Dim i As Integer
Dim RangeStart As Long
Dim RangeEnd As Long
Dim MyRange As Range
On Error Resume Next
Application.ScreenUpdating = False
Selection.WholeStory
CommandBars("Word Count").Visible = True
CommandBars("Word Count").Controls(2).Execute
l = CommandBars("Word Count").Controls(1).List(6)
CommandBars("Word Count").Visible = False
Application.ScreenUpdating = True

LineCount = Int(Mid(l, 1, Len(l) - 1))
With ActiveDocument
For i = LineCount To 1 Step -1
If .Content.End <= 1 Then Exit Sub
RangeStart = .GoTo(wdGoToLine, , i).Start
RangeEnd = VBA.IIf(i = LineCount, .Content.End, .GoTo(wdGoToLine, , i + 1).Start)
Set MyRange = .Range(RangeStart, RangeEnd)
'Debug.Print MyRange
 If MyRange = Chr(13) Then
 MyRange.Select
 Selection.MoveLeft
 Selection.TypeBackspace 

 End If
Next
End With
End Sub