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 = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ,/《》?;':【】{}\|=-+_)(×%$#@!'〜&"
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

评论 2
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值