ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
楼主: weiyingde

[已解决] 优化:保持行距不变保留切换按钮

[复制链接]

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-3-24 12:00 | 显示全部楼层
dafanshu1 发表于 2017-3-24 11:27
因为原代码的Left(istr, 8)没有包含到那个按钮控件,为了不改变原来的嵌入型格式,我改用Range定义范围了 ...

谢谢你的指导,这个问题解决的很好透彻。
还有个问题,就是将这个页面的汉字和拼音在括号的位置互换。
第一步是:目的是将括号里的拼音调到括号前面,将相应的汉字调到括号里面。
       这一步在duquancai 的帮助下,得以实现。
      代码如下:
      Sub 移汉字到括号里对应拼音在括号前()
    Dim reg As Object, mt, mh, oDOC As Document
    Set oDOC = ActiveDocument
    With oDOC.Content.Find
        .Execute "([\((])^32{1,}", , , 1, , , , , , "\1", 2
        .Execute "^32{1,}([\))])", , , 1, , , , , , "\1", 2
        .Execute "^32{1,}", , , 1, , , , , , "^32", 2
    End With
    Set reg = CreateObject("vbscript.regexp")
    reg.Global = True: reg.Pattern = "[\((][^)\)]+[\))]"
    For Each mt In reg.Execute(oDOC.Content)
        m = mt.FirstIndex: n = mt.Length
        With oDOC.Range(m, m + n)
            reg.Pattern = " ": t = reg.Execute(.Text).Count + 1
            .Start = .Start - t
            .Find.Execute "([一-﨩]{" & t & "})([\((])(*)([\))])", , , 1, , , , , , "\3\2\1\4", 1
            reg.Pattern = "[\((][^)\)]+[\))]"
            For Each mh In reg.Execute(.Text)
                f = mh.FirstIndex: l = mh.Length
                With oDOC.Range(.Start + f, .Start + f + l)
                    .Start = .Start + 1: .End = .End - 1
                    .Font.Color = RGB(255, 255, 255)
                End With
            Next
        End With
    Next
End Sub
现在是第二步:要求回到第一步的效果:仍旧讲汉字放到括号前,对应的拼音置于括号里。
  我的核心代码是:
  Sub 移进汉字移出拼音()
With ActiveDocument.Content.Find
     .Execute "([一-﨩]+)([!\(]+)([\(])([一-﨩]+)([\)])", , , 1, , , , , , "\1\4\3\2\5", 1
End With
End Sub请帮我看看,先谢了。
第一步附件在http://club.excelhome.net/thread-1334017-3-1.html 第29楼

TA的精华主题

TA的得分主题

发表于 2017-3-24 13:23 | 显示全部楼层
weiyingde 发表于 2017-3-24 12:00
谢谢你的指导,这个问题解决的很好透彻。
还有个问题,就是将这个页面的汉字和拼音在括号的位置互换。
...

整天折腾过去又折腾回来,想干嘛?又是苦力活!!!

TA的精华主题

TA的得分主题

发表于 2017-3-24 13:25 | 显示全部楼层
weiyingde 发表于 2017-3-24 12:00
谢谢你的指导,这个问题解决的很好透彻。
还有个问题,就是将这个页面的汉字和拼音在括号的位置互换。
...

呵呵,实在抱歉,正则我完全不懂的,楼主你或者另起新贴请教其他高手吧。

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-3-24 13:51 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
duquancai 发表于 2017-3-24 13:23
整天折腾过去又折腾回来,想干嘛?又是苦力活!!!

对不起,打搅了。
是这样,初中语文中,经常有词语解释、字音、自行方便的练习和试题,
我想做成模板,想联系拼音,就把拼音放到括号里;相练习生字,就对调位置,做成一个模版,一版双用,方便使用,随心所欲,同时有通过隐藏和显示答案,做到一个文档作四个文档用。

TA的精华主题

TA的得分主题

发表于 2017-3-24 14:31 | 显示全部楼层
weiyingde 发表于 2017-3-24 13:51
对不起,打搅了。
是这样,初中语文中,经常有词语解释、字音、自行方便的练习和试题,
我想做成模板, ...

Sub W_移形换位()
    Dim p As Range
    Set p = ActiveDocument.Content
    p.Find.Execute "([a-zāáǎàōóǒòêńēéěèīíǐìňūúǔùǖǘǚǜü^32]@)([\((])(*)([\))])", , , 1, , , , , , "\3\2\1\4", 2
End Sub

评分

1

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-3-24 14:42 | 显示全部楼层
duquancai 发表于 2017-3-24 14:31
Sub W_移形换位()
    Dim p As Range
    Set p = ActiveDocument.Content

大侠真是技艺高超,雪中送炭,多次的到帮助,感谢至极!!想跟你学习,又怕打搅你的正常生活,说声对不起了。以后若是有请教,请多原谅!!

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-3-24 16:07 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
dafanshu1 发表于 2017-3-24 13:25
呵呵,实在抱歉,正则我完全不懂的,楼主你或者另起新贴请教其他高手吧。

还是谢谢你,费了你很多的心血和时间,也帮了我的很大的忙。

TA的精华主题

TA的得分主题

发表于 2017-3-24 16:42 | 显示全部楼层
weiyingde 发表于 2017-3-24 16:07
还是谢谢你,费了你很多的心血和时间,也帮了我的很大的忙。

不客气,我也是学习当中。

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-3-24 17:11 | 显示全部楼层
dafanshu1 发表于 2017-3-24 16:42
不客气,我也是学习当中。


着实要感谢duquancai ,他是本坛中的正则高手,我是正则新手,不懂得想问他,但他事情多,又怕麻烦他。
你若是有时间和兴趣,帮我看看最后的测试版,为什么移动汉字到括号里,只能移动一半左右,word你也比我内行,看看为什么。

测试版:效果折半,为什么?.rar

50.84 KB, 下载次数: 15

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-3-24 17:19 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
dafanshu1 发表于 2017-3-24 16:42
不客气,我也是学习当中。

再看看这个,几乎相同的代码,在几乎相同的文档内,为什么会有两种不同的结果?
会不会是你的代码里有格式的原因引起来的呢?

再看看:是不是文字全移进括号里了.rar

38.54 KB, 下载次数: 12

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-12-29 04:15 , Processed in 0.031728 second(s), 8 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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