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兼容問題。