本帖最后由 leikaiyi123 于 2018-7-28 13:13 编辑
我修改了两个,能处理中文和英文双引号同时存在及其遗忘英文右双引号的情况。请大神们讨论。
运行速度跟楼主的一样,都有些慢。
奇怪了,上传不起附件,提示Upload Error: 521。
Sub RelpaceStr2() '缺点:当无中文双引号时,无法正确识别遗忘英文右双引号的情况,如"abcdef,"ghi",123。
Dim sld As Slide, sh As Shape, txtFrame As TextFrame, txtRange As TextRange
Dim tmpRange As TextRange, lCount As Integer
For Each sld In Application.ActivePresentation.Slides
For Each sh In sld.Shapes
Set txtFrame = sh.TextFrame
If txtFrame.HasText = True Then
Set txtRange = txtFrame.TextRange
For i = 1 To Len(txtRange)
If txtRange.Characters(i) Like "[""“”]" Then
lCount = lCount + 1
If txtRange.Characters(i) = "“" Then lCount = 1 '处理遗忘英文右双引号:"abcdef,“ghi",否则此例中最后一个英文双引号会替换为中文左双引号。
If txtRange.Characters(i) = "”" Then lCount = 2 '处理遗忘英文右双引号:"abcdef,“ghiab”,"cdef",否则此例中cdef前的英文双引号会替换为中文右双引号。
If txtRange.Characters(i) Like """" Then
If (lCount Mod 2) = 0 Then '偶数
txtRange.Characters(i) = ChrW(8221)
Else '奇数
txtRange.Characters(i) = ChrW(8220)
End If
End If
End If
Next
End If
lCount = 0
Next
Next sld
End Sub
Sub RelpaceStr3() '正则法,不知什么原因03版对多段落时只能处理第一段,10版没问题
Dim oSld As Slide, oShp As Shape
Dim strPattern As String
Dim oRange As TextRange
Dim iPos As Integer, iLen As Integer, lCount As Integer
' 正则相关变量
Dim regx As Object
Dim mt
strPattern = """|“|”"
Set regx = CreateObject("vbscript.regexp")
With regx
.Pattern = strPattern
.Global = True
.MultiLine = True
.IgnoreCase = True ' 设置不区分大小写。
End With
For Each oSld In ActivePresentation.Slides
For Each oShp In oSld.Shapes
If oShp.HasTextFrame Then
If oShp.TextFrame.HasText Then
Set oRange = oShp.TextFrame.TextRange
For Each mt In regx.Execute(oRange)
lCount = lCount + 1
iPos = mt.Firstindex
'iLen = mt.Length
If oRange.Characters(iPos + 1, 1) = "“" Then lCount = 1 '处理遗忘英文右双引号:"abcdef,“ghi",否则此例中最后一个英文双引号会替换为中文左双引号。
If oRange.Characters(iPos + 1, 1) = "”" Then lCount = 2 '处理遗忘英文右双引号:"abcdef,“ghiab”,"cdef",否则此例中cdef前的英文双引号会替换为中文右双引号。
If oRange.Characters(iPos + 1) Like """" Then
If (lCount Mod 2) = 0 Then
oRange.Characters(iPos + 1, 1) = ChrW(8221)
Else
oRange.Characters(iPos + 1, 1) = ChrW(8220)
End If
End If
Next
End If
End If
lCount = 0
Next oShp
Next oSld
Set regx = Nothing
End Sub
测试文本:
全英:"123","456","789"。 中英混合:“中” , "英" , "英右忘录入。 “左中右英" , "左英右中” , “中右忘录入。 "左英右中” , “左中右英" , "英" 。 “左中右英" , "左英右中” , “中右忘录入。 遗忘英文右双引号:"abcdef, “ghi" 遗忘英文右双引号:"abcdef,“ghiab”,"cdef" 这个缺英文右双引号:"abcdef,"ghiab”,"cdef",第二个英文双引号会被更改为右双引号,出错
|