1234

ExcelHome技术论坛

用户名  找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

[求助] Word录制宏后,让宏对字体的颜色更改为蓝色、无法保存

[复制链接]

TA的精华主题

TA的得分主题

发表于 2015-6-4 20:56 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
楼主,我看你还没提到一个问题:就是每段末尾都有空格这个问题,如果想精美排版必须去除。
现在,我给你一段代码玩玩。——你先打开一篇《中医古籍大全》中的一篇文档,在第2页或第3页或第4页点一下鼠标,然后按 Ctrl+Shift+End 选中后面文字部分,删除之,然后剩下前面的部分“另存为”一个 demo 文件。再对这篇 demo 应用一下我下面的代码,看看效果:
  1. Sub test()
  2.     Dim i As Paragraph
  3.     If ActiveDocument.Characters.Last.Previous.Text <> Chr(13) Then ActiveDocument.Characters.Last.InsertBefore Text:=Chr(13)
  4.     Selection.HomeKey Unit:=wdStory
  5.     Do
  6.         Selection.Find.Execute findtext:="内容:"
  7.         If Selection.Find.Found = False Then Exit Do
  8.         Do
  9.             If Selection.Range Like "*" & vbCr & vbCr Then Exit Do
  10.             Selection.MoveEnd Unit:=wdCharacter, Count:=1
  11.         Loop
  12.         Selection.MoveEnd Unit:=wdCharacter, Count:=-1
  13.         Selection.Font.Color = wdColorBlue
  14.         CommandBars.FindControl(ID:=122).Execute
  15.         CommandBars.FindControl(ID:=123).Execute
  16.         Selection.Find.Execute findtext:="。^p", replacewith:="。`", Replace:=wdReplaceAll
  17.         Selection.Find.Execute findtext:="^p", replacewith:="", Replace:=wdReplaceAll
  18.         Selection.Find.Execute findtext:="。`", replacewith:="。^p", Replace:=wdReplaceAll
  19.         Selection.InsertParagraphAfter
  20.         Selection.MoveRight Unit:=wdCharacter, Count:=1
  21.     Loop
  22.     MsgBox "处理完毕!!!!!!!!!!!!!"
  23. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2015-6-4 20:58 | 显示全部楼层
***为了反复试验文档,测试代码,需要用到下面的宏(此宏在正式编辑时不能用,用了它不保存修改!切记!)------你把它放到工具栏上,设为一个按钮,好反复应用:
  1. Sub 重新打开()
  2.     Dim i As String
  3.     i = ActiveDocument.FullName
  4.     If Mid(i, 2, 1) <> ":" Then Exit Sub
  5.     If ActiveDocument.Saved = False Then
  6.         ActiveDocument.Close savechanges:=wdDoNotSaveChanges
  7.         Documents.Open FileName:=i
  8.     End If
  9. End Sub
复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-6-5 08:00 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
413191246se 发表于 2015-6-4 20:58
***为了反复试验文档,测试代码,需要用到下面的宏(此宏在正式编辑时不能用,用了它不保存修改!切记!)- ...

前辈好!
我试了你给的第一段代码,除了〈目录〉〈篇名〉二行外,正文都变为了蓝色字,试了你给的第二段代码,刚才删除的正文又全部回来了,字的颜色也变回了黑色,是不是这样,我感觉像变戏法,真是让人不可思,我真羡慕你,前辈呀!你有这么好的技术为什么不能把我给你的“宏3”里面的步骤,也单独编一段代码实现它的效果,这样可以至少节省我半年的时间,我又想求你了,前辈!可否满足小弟这个愿望,我真不想天天面对电脑修改这个医书,也想出去玩玩,可“师命”难违呀!前辈!可否请你再辛苦辛苦帮帮小弟!我真得真得很天无奈!真得真得没有办法!

TA的精华主题

TA的得分主题

发表于 2015-6-5 09:15 | 显示全部楼层
楼主 啊!第二段代码是“重新打开”,放弃当前修改,其实是为了测试 demo 文件的,在正式编辑文件时不要用!第一段代码,你只看到了“正文”,你没看到一个特点吗?
——就是,一般每段都有个“内容:”,直到后面有一段空行,我的第一段代码,能查找到“内容:”------->>>直到选定到两个回车符(标准叫法叫:段落符)处,这选定的一段,里面可以简单地把所有回车符替换为无,也可以除句号(。)以外选定区域所有断行相连,这是最重要的!——你想想吧!(至于《目录》《篇名》变蓝色,加五角星和三角形,可以后加)

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-6-5 10:15 | 显示全部楼层
本帖最后由 13907933959 于 2015-6-5 10:32 编辑
413191246se 发表于 2015-6-5 09:15
楼主 啊!第二段代码是“重新打开”,放弃当前修改,其实是为了测试 demo 文件的,在正式编辑文件时不要用 ...

前辈好!你不提醒我还没注意,这个代码还不能用,例如下面一段,(●这里不可连,◆需可连但要有空格,不然草药名会由原来的2个字、3个字变成5个字、6个字)以后就很难再分开,除非一个字一个字去对,哪就要十年的时间也不一定才完成。

<目录>卷一
<篇名>上经
内容:上药一百二十种,为君,主养命以应天,无毒。多服、久服不伤人。欲轻身益气,不老 ◆
延年者,本上经。
丹砂 云母 玉泉 石钟乳 涅石 硝石 朴硝 滑石 石胆 空青 曾青 禹余粮 ◆
太乙余粮 白石英 紫石英 五色石脂 白青 扁青 ◆
上 玉石上品一十八种,旧同●
菖蒲 鞠华 人参 天门冬 甘草 干地黄 术 菟丝子 牛膝 茺蔚子 女萎 防葵 ◆
柴胡 麦门冬 独活 车前子 木香 薯蓣 薏苡仁 泽泻 远志 龙胆 细辛 石斛 巴
戟天
蘼芜 黄连 络石 蒺藜子 黄 肉苁蓉 防风 蒲黄 香蒲 续断 漏芦 营实 ◆
天名精 决明子 丹参 茜根 飞廉 五味子 旋华 兰草 蛇床子 地肤子 景天 茵陈 ◆
杜若 沙参 白兔藿 徐长卿 石龙刍 薇衔 云实 王不留行 升麻 青 姑活 别
羁屈草 淮木 ◆
上 草上品七十三种,旧七十二种 ●
牡桂 菌桂 松脂 槐实 枸杞 柏实 茯苓 榆皮 酸枣 柏木 干漆 五加皮 蔓
荆实 辛夷 桑上寄生 杜仲 女贞实 木兰 蕤核 橘柚 ◆
上 木上品二十种。旧一十九种 ●
发皮●
上 人一种。旧同 ●
龙骨、麝香、牛黄、熊脂、白胶、阿胶 ◆
上 兽,上品六种。旧同 ●
丹雄鸡、雁肪 ◆
上 禽,上品二种。旧同 ●
石蜜、蜂子、蜜蜡、牡蛎、龟甲、桑螵蛸、海蛤、文蛤、蠡鱼、鲤鱼胆◆
上 虫鱼,上品一十种。旧同 ●
藕实茎、大枣、葡萄、蓬 鸡头实 ◆
上 果,上品五种。旧六种 ●
胡麻 麻贲 ◆
上 米谷上品二种,旧三种。
冬葵子 苋实 瓜蒂 瓜子 苦菜 ◆
上 菜,上品五种。旧同 ●


替换后则成这样,就破坏了原段或原句的意思


<目录>卷一
<篇名>上经
内容:上药一百二十种,为君,主养命以应天,无毒。多服、久服不伤人。欲轻身益气,不老延年者,本上经。
丹砂 云母 玉泉 石钟乳 涅石 硝石 朴硝 滑石 石胆 空青 曾青 禹余粮太乙余粮 白石英 紫石英 五色石脂 白青 扁青上 玉石上品一十八种,旧同菖蒲 鞠华 人参 天门冬 甘草 干地黄 术 菟丝子 牛膝 茺蔚子 女萎 防葵柴胡 麦门冬 独活 车前子 木香 薯蓣 薏苡仁 泽泻 远志 龙胆 细辛 石斛 巴戟天蘼芜 黄连 络石 蒺藜子 黄 肉苁蓉 防风 蒲黄 香蒲 续断 漏芦 营实天名精 决明子 丹参 茜根 飞廉 五味子 旋华 兰草 蛇床子 地肤子 景天 茵陈杜若 沙参 白兔藿 徐长卿 石龙刍 薇衔 云实 王不留行 升麻 青 姑活 别羁屈草 淮木上 草上品七十三种,旧七十二种牡桂 菌桂 松脂 槐实 枸杞 柏实 茯苓 榆皮 酸枣 柏木 干漆 五加皮 蔓荆实 辛夷 桑上寄生 杜仲 女贞实 木兰 蕤核 橘柚上 木上品二十种。旧一十九种发皮上 人一种。旧同龙骨、麝香、牛黄、熊脂、白胶、阿胶上 兽,上品六种。旧同丹雄鸡、雁肪上 禽,上品二种。旧同石蜜、蜂子、蜜蜡、牡蛎、龟甲、桑螵蛸、海蛤、文蛤、蠡鱼、鲤鱼胆上 虫鱼,上品一十种。旧同藕实茎、大枣、葡萄、蓬 鸡头实上 果,上品五种。旧六种胡麻 麻贲上 米谷上品二种,旧三种。
冬葵子 苋实 瓜蒂 瓜子 苦菜上 菜,上品五种。旧同


前辈!我说的“宏3”里面的步骤是指下面的这个,“宏4”是〈目录〉〈篇名〉二变蓝色。


,^?^P替换成绿色
,^?^?^P替换成绿色
,^?^?^?^P替换成绿色
、^?^P替换成绿色
、^?^?^P替换成绿色
^P^?,替换成绿色
^P^?^?,替换成绿色
^P^?^?^?,替换成绿色
《^?^P替换成绿色
《^?^?^P替换成绿色
《^?^?^?^P替换成绿色
“^?^P替换成绿色
“^?^?^P替换成绿色
^P^?》替换成绿色
^P^?^?》替换成绿色
^P^?^?^?》替换成绿色
》^?^P替换成绿色
》^?^?^P替换成绿色
^P^?。替换成绿色
^P^?^?。替换成绿色
(^P替换成绿色
(^?^P替换成绿色
(^?^?^P替换成绿色
^P^?^P替换成绿色
^P^?^?^P替换成绿色
^P?(这个红色的?是普通的问号)替换成绿色
^P^?)替换成绿色
^P^?^?)替换成绿色
^P^?^?^?)替换成绿色
^P^#.替换成绿色
1、查找绿色^P替换为空白(不填任何内容)
2、查找绿色.替换为、

3、查找绿色替换为黑色



TA的精华主题

TA的得分主题

发表于 2015-6-5 16:18 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
楼主,^p^?等,须用英文半角的,不能用中文全角的,但——你的这些我放到代码中,程序无法通过。因为替换为框中不能有 ^?
因为每一篇都挺长,我觉得要不手工一篇一篇地校对,要不就不要校对,就保持原样(当然加星号、蓝色这都好办),像你上面这些替换为绿色法,我用程序实在通不过,程序不允许。请另外思考。。。

TA的精华主题

TA的得分主题

发表于 2015-6-5 16:22 | 显示全部楼层
楼主,我给你一段代码,前些天给过的,你试着把(findtext:="",双引号中间是要查找的词,replacewith:="",双引号中间是要替换为的词)^? 放到双引号中,试试程序能不能通过?再换成汉字试试。
以这段文字为 demo 试试——“你给我的文字我却录不到应该怎么办?录不到可以编。”
  1. Sub test()
  2. '对文字进行字体、字号、颜色、加粗控制
  3.     With ActiveDocument.Content.Find
  4.         .ClearFormatting
  5.         With .Replacement
  6.             .ClearFormatting
  7.             .Font.Name = "黑体"
  8.             .Font.Size = 22
  9.             .Font.Bold = True
  10.             .Font.Color = wdColorRed
  11.         End With
  12.         .Execute FindText:="录不到", ReplaceWith:="录不到可以编", Format:=True, Replace:=wdReplaceAll
  13.     End With
  14. End Sub
复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-6-5 17:38 | 显示全部楼层
413191246se 发表于 2015-6-5 16:22
楼主,我给你一段代码,前些天给过的,你试着把(findtext:="",双引号中间是要查找的词,replacewith:="", ...

前辈好!
这段代码运行不了,出现警示框提示:编译错误,在End sud End Func tion或End属性后面只能出现注释。

TA的精华主题

TA的得分主题

发表于 2015-6-5 19:13 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
楼主,你把 57 楼的代码用它的“复制代码”复制一下到剪贴板,再粘贴到你的 VBE 中,在我这儿运行好好的。

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-6-5 19:35 | 显示全部楼层
本帖最后由 13907933959 于 2015-6-5 19:44 编辑
413191246se 发表于 2015-6-5 19:13
楼主,你把 57 楼的代码用它的“复制代码”复制一下到剪贴板,再粘贴到你的 VBE 中,在我这儿运行好好的。

前辈好!
从57楼复制到剪贴板再粘贴到VBA内,可运行,可文档除了闪了一下,好象没有什么其它变化,57楼页面上看到的代码和复制到剪贴板的代码好象不一样。

少了下面的:  
.Execute FindText:=" ,^?^P ", ReplaceWith:="录不到可以编", Format:=True, Replace:=wdReplaceAll
    EndWith
End Sub

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

本版积分规则

1234

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

GMT+8, 2025-1-24 07:57 , Processed in 0.023901 second(s), 7 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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