ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

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

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

[复制链接]

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-6-30 12:08 | 显示全部楼层
413191246se 发表于 2015-6-28 12:44
'楼主,因为你未说清颜色/字体/小二字段(这个字段中是纯粹的颜色/宋体/小二还是有多种格式没明说,我就不 ...

师傅、 徒弟又碰到了新问题,你昨天给我的Sub find_x() '查找 \x隆庆辛未\x 字样,使之单独成段的代码,我在上面添加了几个步骤,在300KB左右的文档上可正常运成替换,可在大以400KB的文档上就不成,最后停留在全选状态下死机(试了好多次),求师傅答救。
Sub find_x()
ActiveDocument.Content.Find.Execute FindText:="\x、", ReplaceWith:="\x", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="、\x", ReplaceWith:="\x", Replace:=wdReplaceAll
'查找 \x隆庆辛未\x 字样,使之单独成段
    Selection.HomeKey Unit:=wdStory
    Do
        Selection.Find.Execute findtext:="\x", Forward:=True, Wrap:=wdFindStop
        If Selection.Find.Found = False Then Exit Do
        Do
            Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
            If Right(Selection, 2) = "\x" Then
                Selection.InsertParagraphBefore
                Selection.InsertParagraphAfter
                Selection.MoveStart Unit:=wdCharacter, Count:=1
                Exit Do
            End If
        Loop
        Selection.MoveRight Unit:=wdCharacter, Count:=1
    Loop
ActiveDocument.Content.Find.Execute FindText:="^p^p^p\x", ReplaceWith:="^p\x", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="^p^p\x", ReplaceWith:="^p\x", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="\x^p^p^p", ReplaceWith:="\x^p", Replace:=wdReplaceAll
ActiveDocument.Content.Find.Execute FindText:="\x^p^p", ReplaceWith:="\x^p", Replace:=wdReplaceAll
End Sub

文档.zip

170.27 KB, 下载次数: 7

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-6-30 14:57 | 显示全部楼层
413191246se 发表于 2015-6-30 10:21
楼主,下面是《全文红色/宋体/小二_前后插入书名号》三个宏:(楼主问题WAIT)
************************* ...

师傅、刚才用了这3个宏,一样的蓝波湾!只是让师傅你受累了、徒弟感激!!!

TA的精华主题

TA的得分主题

发表于 2015-6-30 16:51 | 显示全部楼层
楼主,因你未说清符号在段落首尾,是要设置整个段落还是设置该符号的颜色/字体/字号,所以,我选前者。
************下面是 4 个宏,前 3 个是可以执行的宏,第 4 个宏只是引用的,不必执行(要想执行,须先选定段落------另外,我也忘了说,如果 VBE 中有两个宏是同名的,它会提示出错或好用的宏也不能用了,只是因为有同名的宏,这一点要注意,就是不能有两个 test 宏。):

Sub 首尾符号()
'7、句子开头和结尾带有符号的如:[] 、\X  改变颜色,如:黑色改为紫色
'8、句子开头和结尾带有符号的改变字体,如:宋体改为楷体
'9、句子开头和结尾带有符号的改变字号,如:小二改为小五
    Dim i As Paragraph, j As String
    j = InputBox("请输入单个字符(如:“\”或“[”等)", "段落首尾有符号_黑色改为紫色", "\")
    If j = "" Then Exit Sub
    For Each i In ActiveDocument.Paragraphs
        If i.Range.Characters(1).Text = j Or i.Range.Characters.Last.Previous.Text = j Then i.Range.Font.Color = wdColorPink '粉红
        If i.Range.Characters(1).Text = j Or i.Range.Characters.Last.Previous.Text = j Then i.Range.Font.Name = "楷体_GB2312"
        If i.Range.Characters(1).Text = j Or i.Range.Characters.Last.Previous.Text = j Then i.Range.Font.Size = 9 '小五
    Next
End Sub
Sub 全文查找_红色宋体小二_前后添加书名号()
    Dim i As Paragraph
    For Each i In ActiveDocument.Paragraphs
        i.Range.Select
        FindSymbol
    Next
End Sub
Sub 单行查找_红色宋体小二_前后添加书名号()
    Dim i As Paragraph
    For Each i In ActiveDocument.Paragraphs
        i.Range.Select
        Selection.HomeKey Unit:=wdLine
        Selection.EndKey Unit:=wdLine
        If Asc(Selection) = 13 Then
            i.Range.Select
            FindSymbol
        End If
    Next
End Sub
Sub FindSymbol()
    Selection.HomeKey Unit:=wdLine
    Do
        Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
        If Selection.Characters.Last.Text = vbCr Then Exit Do
        If (Selection.Characters.Last.Font.Color = wdColorRed And Selection.Characters.Last.Font.Name = "宋体") And Selection.Characters.Last.Font.Size = 18 Then
            Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
            If (Selection.Characters.Last.Font.Color = wdColorRed And Selection.Characters.Last.Font.Name = "宋体") And Selection.Characters.Last.Font.Size = 18 Then
                Do
                    If Selection.Characters.Last.Text = vbCr Then Exit Do
                    If (Selection.Characters.Last.Font.Color = wdColorRed And Selection.Characters.Last.Font.Name = "宋体") And Selection.Characters.Last.Font.Size = 18 Then
                        Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
                    Else
                        Selection.MoveEnd Unit:=wdCharacter, Count:=-1
                        Exit Do
                    End If
                Loop
            Else
                Selection.MoveEnd Unit:=wdCharacter, Count:=-1
            End If
            Selection.InsertBefore Text:="《"
            Selection.Font.Color = wdColorRed: Selection.Font.Name = "宋体": Selection.Font.Size = 18
            If Selection.Characters.Last.Text = vbCr Then Selection.MoveEnd Unit:=wdCharacter, Count:=-1
            Selection.InsertAfter Text:="》"
            Selection.MoveRight Unit:=wdCharacter, Count:=1
        Else
            Selection.MoveRight Unit:=wdCharacter, Count:=1
        End If
    Loop
End Sub

TA的精华主题

TA的得分主题

发表于 2015-6-30 17:55 | 显示全部楼层
楼主,find_x 使之单独成段宏,确实有毛病,毛病就在于\x前面有,后面没有,不配套(成对),陷入了无限循环中,我改为:每个段落只要遇到最后一个字符(段落符,也叫回车符),就退出循环了,以后遇到这种问题,就按 Ctrl + PauseBreak 键结束程序。
另外:我建议,先确定一下,是否要:全文--删除段落首尾空格,全文--删除空行,你好好想想,要是删除这么没用的空格、空行,文章会变得更加干净。
如果有同名的宏,VBE会不执行或说有问题,注意不要有同名的宏存在。
********(下面提供的宏中,如果想删除空行,必须先执行《删除段落首尾空格》宏才可。如果想把选定区域或全文清除格式,可以执行《清除格式》宏,都变成默认的宋体小五单倍行距网格勾选样式)

Sub find_x()
    ActiveDocument.Content.Find.Execute findtext:="\x、", ReplaceWith:="\x", Replace:=wdReplaceAll
    ActiveDocument.Content.Find.Execute findtext:="、\x", ReplaceWith:="\x", Replace:=wdReplaceAll
'查找 \x隆庆辛未\x 字样,使之单独成段
    Selection.HomeKey Unit:=wdStory
    Do
        Selection.Find.Execute findtext:="\x", Forward:=True, Wrap:=wdFindStop
        If Selection.Find.Found = False Then Exit Do
        Do
            Selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
            If Selection.Characters.Last.Text = vbCr Then Exit Do
            If Right(Selection, 2) = "\x" Then
'                Selection.Font.Color = wdColorRed '红色(不想要颜色,可删除此行语句!)
                Selection.InsertParagraphBefore
                Selection.InsertParagraphAfter
                Selection.MoveStart Unit:=wdCharacter, Count:=1
                Exit Do
            End If
        Loop
        Selection.MoveRight Unit:=wdCharacter, Count:=1
    Loop
    ActiveDocument.Content.Find.Execute findtext:="^p^p^p\x", ReplaceWith:="^p\x", Replace:=wdReplaceAll
    ActiveDocument.Content.Find.Execute findtext:="^p^p\x", ReplaceWith:="^p\x", Replace:=wdReplaceAll
    ActiveDocument.Content.Find.Execute findtext:="\x^p^p^p", ReplaceWith:="\x^p", Replace:=wdReplaceAll
    ActiveDocument.Content.Find.Execute findtext:="\x^p^p", ReplaceWith:="\x^p", Replace:=wdReplaceAll
End Sub
Sub 删除段落首尾空格()
    With ActiveDocument.Content.Find
        .Execute findtext:="^l", ReplaceWith:="^p", Replace:=wdReplaceAll
        .Execute findtext:="^13", ReplaceWith:="^p", Replace:=wdReplaceAll
    End With
    Selection.WholeStory
    CommandBars.FindControl(ID:=122).Execute
    CommandBars.FindControl(ID:=123).Execute
End Sub
Sub 删除空行()
    Dim i As Paragraph
    For Each i In ActiveDocument.Paragraphs
        If Len(i.Range) = 1 Then i.Range.Delete
    Next
End Sub
Sub 清除格式()
    Selection.WholeStory
    Selection.ClearFormatting
    Selection.ClearFormatting
End Sub

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-6-30 20:17 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 13907933959 于 2015-7-1 07:32 编辑
413191246se 发表于 2015-6-30 16:51
楼主,因你未说清符号在段落首尾,是要设置整个段落还是设置该符号的颜色/字体/字号,所以,我选前者。
** ...

师傅好!
这又怪我没有描述清楚,真是笨徒弟要累死师傅!惩罚徒弟吧!
1、符号在文档内的位置不确定,有在段落首尾的,有在一行文字中间的。
2、我是要设置符号内文字的颜色/字体/字号,包括符号在内。
3、每个宏要可分开用。
4、其中一个符号\x,斜扛和X是连在一起的,不是单一斜扛\

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-6-30 20:35 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
本帖最后由 13907933959 于 2015-6-30 20:40 编辑
413191246se 发表于 2015-6-30 17:55
楼主,find_x 使之单独成段宏,确实有毛病,毛病就在于\x前面有,后面没有,不配套(成对),陷入了无限循 ...

师傅好!
不能全文--删除段落首尾空格,全文--删除空行,首行空2格这种格式是我师傅要的,他的所有文档都是这种格式。再一个在这种格式上建立的文件太多太多,我和师兄们一起花的时间加起来有几年的时间。如改动实在是不可想象,师傅还是求你给想想办法。

TA的精华主题

TA的得分主题

发表于 2015-7-1 15:58 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
楼主,不必着急!有些WORD外行人士(不知你是不是)以为要在每段首行加两个空格或一个全角空格才好让文档看起来排版正常,其实正确的做法是,设置该段或选定范围或全文为“首行缩进2字符”即可,这放到一边吧,楼主我也不是想让你这么做,原来什么样现在就什么样吧,保持原样。——184楼是 find_x 更新代码。

TA的精华主题

TA的得分主题

 楼主| 发表于 2015-7-1 20:02 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 13907933959 于 2015-7-1 20:05 编辑
413191246se 发表于 2015-7-1 15:58
楼主,不必着急!有些WORD外行人士(不知你是不是)以为要在每段首行加两个空格或一个全角空格才好让文档看 ...

师傅好!

我师傅的所有文档在去年我去之前,由我一个师兄(他的电脑技术比我还要差)搞的,现在只能是在错的基础上任其发展,一个是我不愿做这个辛苦不讨好的事,再一个也不是我自己的电脑,我和师傅共用它。


师傅、我以为184楼find_x 更新代码,要全文--删除段落首尾空格,全文--删除空行后才能用,所以求师傅你给想想办法,原来可以用,看我这个笨老瓜。


下面这个Sub 首尾符号()的宏:


1、符号在文档内的位置不确定,有在段落首尾的,有在一行文字中间的。
2、是要查找替换符号内文字的颜色/字体/字号,包括符号在内。
3、每个宏要可分开用。
4、符号\x, \和X是连在一起的,不是单一的斜扛\


Sub 首尾符号()
'7、句子开头和结尾带有符号的如:[] 、\X  改变颜色,如:黑色改为紫色
'8、句子开头和结尾带有符号的改变字体,如:宋体改为楷体
'9、句子开头和结尾带有符号的改变字号,如:小二改为小五
   …………


师傅、等你有时间、可否再帮我把这几个宏分别再加一个颜色、字体、字号的控制代码,比方说:现在在同一篇文档中,我用“单行宋体字”前后加引号的宏,想给单行黑色、宋体、小三字前后加上了引号,会连同该文档中的单行其它颜色的宋体字及其它字号的宋体字前后都加上了引号,如果能在颜色、字体、字号上设置三项控制代码,就可准确无误的加上引号,这个控置颜色、字体、字号的代码,能设计一个活的就更好,不用颜色、字体、字号控制时也可不设置,代码照样能用。


徒弟谢谢师傅了!

TA的精华主题

TA的得分主题

发表于 2015-7-1 20:15 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2015-7-1 20:16 | 显示全部楼层
楼主,183楼就是你要的答案!至于怎么换颜色/字体/字号,容空告诉你。
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2025-1-16 04:47 , Processed in 0.036321 second(s), 8 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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