VBA操作WORD（二）：替换字符（含空格、全角字符、换行符等）

这篇实现WPS文字工具提供的几个小功能：

Sub 段落首行缩进转为空格()
    Dim ib As Paragraph
    For Each ib In ActiveDocument.Paragraphs
    '排除表格
    If ib.Range.Information(wdWithInTable) = False Then
        ib.Range.Select
        '缩进不一定是2个字符，只要缩进不为0就替换，避免标题、主送对象等误操作
        If ib.Range.ParagraphFormat.FirstLineIndent > 0 Or ib.Range.ParagraphFormat.CharacterUnitFirstLineIndent > 0 Then
            With Selection.ParagraphFormat
                .CharacterUnitFirstLineIndent = 0
                .FirstLineIndent = 0
            End With
            ib.Range.Words(1).InsertBefore "　　" '插入2个全角字符
        End If
    End If
    Next
End Sub

  

'第一个参数是目标替换字符串，第二个参数是替换后的字符串
Sub 自定义替换(tarText As String, repText As String)
    'Application.ScreenUpdating = False
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = tarText
        .Replacement.Text = repText
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = True
        .MatchWildcards = True '要设置为True，否则通配符不生效
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    ActiveWindow.ActivePane.VerticalPercentScrolled = 0
End Sub

 

Sub 删除段首空格()
'含全角和半角空格；WPS只删空格
    Call 自定义替换("^13[ 　]{1,}", "^13")
End Sub

Sub 换行符转为回车()
    Call 自定义替换("^l", "^13") '换行符转为回车
End Sub

^p在微软Word中会报错，WPS中^13和^p都可以执行上面的代码。

 

    '.Text = """(*)"""
    '.Replacement.Text = ChrW(8220) & "\1" & ChrW(8221)
    '也可以将空格、全角空格替换掉

    '注意：如果表格中有回车符，会造成误操作。
    Call 自定义替换("^13{2,}", "^p") '删除2或以上空行，^13是回车符，^p为段落标记 

 

 

替换全角字符：

Dim qjsz, bjsz As String, iii As Integer
qjsz = "０１２３４５６７８９ａｂｃｄｅｆｇｈｉｊｋｌｍｎｏｐｑｒｓｔｕｖｗｘｙｚＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰＱＲＳＴＵＶＷＸＹＺ,/<>?;’:[]{}\|=-+_)(*%$#@!`~&"
bjsz = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ，／《》？；'：【】｛｝＼｜＝－＋＿）（×％＄＃＠！'〜＆"
Selection.WholeStory
For iii = 1 To 95
With Selection.Find
.Text = Mid(qjsz, iii, 1)
.Replacement.Text = Mid(bjsz, iii, 1)
.Format = False
.MatchWildcards = False
.Execute Replace:=wdReplaceAll
End With
Next iii

 

全文搜索关键字（Exit Do没注释掉就表示匹配第一个）：

Sub 全文搜索关键字()
'注意下面三处Selection不是同一个对象。
    Selection.HomeKey unit:=wdStory
    Do While Selection.Find.Execute(FindText:="关键字", Forward:=True) = True
        Selection.MoveStart unit:=wdParagraph, Count:=-1 '选中关键字所在段落
        With Selection
            '这里可以用Selection进行处理。
        End With

        Exit Do '第一次匹配成功就跳出循环，后面不处理
    Loop
End Sub

 

--更新于2020/4/24--

1.增加段落首行缩进转为空格功能；

2.完善段落标记在微软word兼容问题。