ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 1975|回复: 9

[求助] ppt英文双引号转中文双引号

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-7-20 09:46 | 显示全部楼层 |阅读模式
本帖最后由 dongdonggege 于 2018-7-20 10:15 编辑

我曾在word论坛看到英文双引号替换中文双引号(http://club.excelhome.net/forum. ... =767770&pid=8445790),想在ppt中也能实现,自己试着写了一个ppt的英文双引号转中文双引号。Chr(34)为英文的直双引号,ChrW(8220)为中文左双引号,ChrW(8221)为中文右双引号。
  1. Sub ppt英文双引号转中文4() '
  2.     On Error Resume Next
  3.     For Each sld In Application.ActivePresentation.Slides
  4.         For Each shp In sld.Shapes
  5.             Set txtrng = shp.TextFrame.TextRange
  6.             Set foundText = shp.TextFrame.TextRange.Find(FindWhat:=Chr(34))
  7.             If txtrng.Find(FindWhat:=Chr(34), Forward:=True) Then
  8.                 txtrng.Characters(foundText.Start) = ChrW(8220)
  9.                 Do
  10.                     For i = foundText.Start To txtrng.Characters.Length - 1
  11.                         txtrng.Characters(Start:=i, Length:=1).Select
  12.                         If txtrng.Characters(i) = Chr(34) Then
  13.                             txtrng.Characters(i) = ChrW(8221)
  14.                             Exit Do
  15.                         End If
  16.                     Next
  17.                 Loop Until Asc(txtrng.Characters) = Chr(34)
  18.             End If
  19.         Next
  20.     Next
  21. End Sub
复制代码
不知道为什么,还有一点瑕疵,程序运行后,只能替换两组英文双引号,第三组及以后不能替换。我想一定是循环里出现了问题,但没法解决,那位高手有兴趣的话帮我看下。
我把word的英文双引号转中文的献上,供参考
  1. Sub word英文双引号转中文()
  2.     Selection.HomeKey Unit:=wdStory
  3.     Selection.Find.ClearFormatting
  4.     Do While Selection.Find.Execute(findtext:=Chr(34), Forward:=True)
  5.         Selection.Range.CharacterWidth = wdWidthFullWidth
  6.         Selection.MoveRight Unit:=wdCharacter, Count:=1
  7.     Loop
  8.     Selection.HomeKey Unit:=wdStory
  9.     Selection.Find.ClearFormatting
  10.     Do While Selection.Find.Execute(findtext:=Chr(-23646), Forward:=True)
  11.         Selection = ChrW(8220)
  12.         Do
  13.             If Selection.Characters.Last.Text = vbCr Then GoTo Skip
  14.             Selection.MoveEnd Unit:=wdCharacter, Count:=1
  15.         Loop Until Asc(Selection.Characters.Last) = -23646
  16.         Selection.Characters.Last.Text = ChrW(8221)
  17. Skip:
  18.         Selection.MoveRight Unit:=wdCharacter, Count:=1
  19.     Loop
  20. End Sub
复制代码
请看附件。

演示文稿2.zip

16.64 KB, 下载次数: 6

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-7-20 09:58 | 显示全部楼层
这个替换的思想:
1、先找到第一个英文双引号,替换为中文左双引号。
2、然后选择这个字符向后移动,找到第二个英文双引号,替换为中文右双引号。
3、退出循环。
4、重复1—2的步骤,直到查找所有的英文双引号为止。
我好像对循环的控制方面没做好,第二组替换后,第三组没开始就结束了。

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-7-21 09:51 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-7-21 09:52 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
我对循环还是不熟练。

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-7-26 09:09 | 显示全部楼层
感谢@pptaddins
  1. Sub RelpaceStr()
  2.     Dim sld As Slide, sh As Shape, txtFrame As TextFrame, txtRange As TextRange
  3.     Dim tmpRange As TextRange, lCount As Integer
  4.    
  5.     For Each sld In Application.ActivePresentation.Slides
  6.         For Each sh In sld.Shapes
  7.             Set txtFrame = sh.TextFrame
  8.             If txtFrame.HasText = True Then
  9.                 Set txtRange = txtFrame.TextRange
  10.                 '替换第一个英文引号,成功返回对象
  11.                 Set tmpRange = txtRange.Replace(Chr(34), ChrW(8220), , , True)
  12.                 '若成功返回
  13.                 If Not tmpRange Is Nothing Then
  14.                     '计数加1,单数表示左引号
  15.                     lCount = lCount + 1
  16.                     '循环检测
  17.                     Do While Not tmpRange Is Nothing
  18.                         '计数加1,双数表示右引号
  19.                         lCount = lCount + 1
  20.                         If (lCount Mod 2) = 0 Then
  21.                             '英文右引号替换成中文右引号
  22.                             Set tmpRange = txtRange.Replace(Chr(34), ChrW(8221), tmpRange.Start + tmpRange.Length, , True)
  23.                         Else
  24.                             '英文左引号替换成中文左引号
  25.                             Set tmpRange = txtRange.Replace(Chr(34), ChrW(8220), tmpRange.Start + tmpRange.Length, , True)
  26.                         End If
  27.                     Loop
  28.                 End If
  29.             End If
  30.         Next
  31.     Next sld
  32. End Sub
复制代码

问题解决

TA的精华主题

TA的得分主题

发表于 2018-7-27 14:30 | 显示全部楼层
本帖最后由 leikaiyi123 于 2018-7-27 14:46 编辑
dongdonggege 发表于 2018-7-26 09:09
感谢@pptaddins

问题解决

上面代码也不完美,只能处理全文都是英文双引号的。
一篇文章有可能既有中文双引号,又有个别误录入的英文双引号,上面代码就会出现错误。
比如:“(中)ABCDEFG"(英),上面代码会将(英)前面的英文双引号处理成左双引号,因为代码识别它是第一个英文双引号,为奇数,而事实上它应该是右双引号,前面已有左双引号了。
看来统计双引号的个数应该同时考虑中英文双引号的个数。
请大神修正上面代码。当然也可以先将所有中文双引号替换为英文双引号后,然后再执行以上代码。

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-7-27 16:16 | 显示全部楼层
leikaiyi123 发表于 2018-7-27 14:30
上面代码也不完美,只能处理全文都是英文双引号的。
一篇文章有可能既有中文双引号,又有个别误录入的英 ...

中文双引号要配对,英文双引号也要配对,不仅是程序,人也很难智能分辨缺的另一个双引号在哪。
当然我的程序和第三个程序还有不足,程序运行时,有时找不到双引号变量的值,我正在研究调试。

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-7-27 18:44 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
leikaiyi123 发表于 2018-7-27 14:30
上面代码也不完美,只能处理全文都是英文双引号的。
一篇文章有可能既有中文双引号,又有个别误录入的英 ...

英文字串的,把Replace函数的最后一个参数改为False,中文字串的,把Replace函数的最后一个参数改为True,大概有三处。

TA的精华主题

TA的得分主题

发表于 2018-7-27 19:29 | 显示全部楼层
本帖最后由 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",第二个英文双引号会被更改为右双引号,出错


TA的精华主题

TA的得分主题

 楼主| 发表于 2018-7-27 19:40 | 显示全部楼层
leikaiyi123 发表于 2018-7-27 19:29
我修改了两个,能处理中文和英文双引号同时存在及其遗忘英文右双引号的情况。请大神们讨论。
奇怪了,上传 ...

传不了附件,可以传代码
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

最新热点上一条 /1 下一条

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-4-26 15:40 , Processed in 0.033106 second(s), 10 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表