怎样用vba实现字体格式替换

润彩绘真

根据公文要求，一级标题（一、　二、　三、）用黑体，二级（（一）（二）（三））用宋体，三级（1.　2.　3.）用楷休。在不用vba的情况下，运用查找替换功能，设计了一下：
在查找中输入“(^13[一二三四五六七八九十]{1,}、)(*^13)”，在替换框内不输入内容而是将格式字体调为黑体，勾选使用通配符。即可实现一级标题格式的替换。但用录制宏的方法却发现不能实现。请高手指点。如何实现？可否一、二、三级标题格式一并调整？不胜感激。
详见附件。

润彩绘真

不好意思，发现样本中第一段“一、”前应有一个段落标记的。若没有只能替换“二、”所在标题行。
因为在实际文本中由于有大标题的存在，第一段前肯定会有段落标志。重新上传样本。

[ 本帖最后由 润彩绘真 于 2010-12-9 16:50 编辑 ]

szqhb

实测，运行录制的宏会将查找到的内容删除掉

[ 本帖最后由 szqhb 于 2010-12-10 16:44 编辑 ]

szqhb

楼主，为你“组装”了一段宏希望能帮到你，欢迎批评指正，共同学习（本人测速成功）
将下面的宏全部复制到宏模块里，运行第一个宏即可
注意：二级标题数字的括号必须是中文括号；三级标题数字后面的点必须是英文标点

Sub 运行此宏设置三级标题格式()
      Call 循环查找一级标题并替换
      Call 循环查找二级标题并替换
      Call 循环查找三级标题并替换
End Sub

Sub 循环查找一级标题并替换()
Dim I As Integer '循环执行
For I = 1 To 100 '假设有100个，循环执行100次
    ' 查找一二三……十加顿号开头的段落
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "(^13[一二三四五六七八九十]{1,}、)(*^13)"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute ' 设置字体字号 Macro
    Selection.Font.Name = "黑体" '字体
    Selection.Font.Bold = wdToggle '加粗
    Selection.Font.Size = 16 '字号，14=四号；16=三号……
Next I
End Sub

Sub 循环查找二级标题并替换()
Dim I As Integer '循环执行
For I = 1 To 100 '假设有100个，循环执行100次
    ' 查找一二三顿号开头的段落
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "(^13（[一二三四五六七八九十]{1,}）)(*^13)"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute ' 设置字体字号 Macro
    Selection.Font.Name = "宋体" '字体
    Selection.Font.Size = 16 '字号，14=四号；16=三号……
Next I
End Sub


Sub 循环查找三级标题并替换()
Dim I As Integer '循环执行
For I = 1 To 100 '假设有100个，循环执行100次
    ' 查找一二三顿号开头的段落
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "(^13[1234567890]{1,}.)(*^13)"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute ' 设置字体字号 Macro
    Selection.Font.Name = "楷体" '字体
    Selection.Font.Size = 16 '字号，14=四号；16=三号……
Next I
End Sub

润彩绘真

真诚的感谢szqhb，在努力争取提高的过程中，这一刻真让人心情愉快，也有了进一步学习的动力。

周星骋

楼主的替换用错了。
既然知道勾选使用通配符，
既然知道查找中输入“(^13[一二三四五六七八九十]{1,}、)(*^13)”，
为何在替换框内不输入内容？

“替换为”应该输入内容：
\1\2
（再用楼主的：将格式字体调为黑体。）

这样录制宏就没问题了。