小恐龙公文排版助手
删除段前段后空格和空白行
Sub CleanUpWordDocument()
Dim rng As Range
Set rng = ActiveDocument.Content
 
' 第一步：将连续的空格替换为单个空格
With rng.Find
.ClearFormatting
.Text = " " ' 两个空格
.Replacement.Text = " " ' 单个空格
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
 
' 如果仍存在多个空格（超过两个），继续执行替换
Do While rng.Find.Execute
With rng.Find
.ClearFormatting
.Text = " " ' 两个空格
.Replacement.Text = " " ' 单个空格
.Execute Replace:=wdReplaceAll
End With
Loop
 
' 第二步：将空格加^p替换为^p
With rng.Find
.ClearFormatting
.Text = " ^p" ' 空格加^p
.Replacement.Text = "^p" ' 替换为^p
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
 
' 第三步：将^p加空格替换为^p
With rng.Find
.ClearFormatting
.Text = "^p " ' ^p加空格
.Replacement.Text = "^p" ' 替换为^p
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
 
' 第四步：将连续的^p替换为单个^p
With rng.Find
.ClearFormatting
.Text = "^p^p" ' 两个^p
.Replacement.Text = "^p" ' 替换为单个^p
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
 
' 如果存在超过两个的连续^p，重复替换，确保最终只有单个^p
Do While rng.Find.Execute
With rng.Find
.ClearFormatting
.Text = "^p^p" ' 两个^p
.Replacement.Text = "^p" ' 替换为单个^p
.Execute Replace:=wdReplaceAll
End With
Loop
 
Selection.WholeStory 'CTR+A
Selection.ParagraphFormat.Alignment=wdAlignParagraphCenter 'CTR+E
Selection.ParagraphFormat.Reset 'CTR+Q
 
End Sub
2024-12-02
浏览400
【论坛】VBA脚本
登录后评论
5
4