如何用vba修改字体（分汉字、英文、数字三个类型修改）

andy800529

在excel中修改字体和格式好像还蛮容易的，但是在word当中似乎就难多了。

    Sub ff()
    Dim a As Integer
    Dim bb As Range
    For i = 1 To 2
    For j = 1 To 5
    Set bb = ActiveSheet.Cells(i, j)
    For j1 = 1 To Len(bb)
    a = Asc(Mid(ActiveSheet.Cells(i, j), j1, 1))
    Select Case a
    Case Is < 0
    bb.Characters(j1, 1).Font.Name = "华文细黑"
    Case 48 To 57
    bb.Characters(j1, 1).Font.Name = "Arial"
    Case Else
    bb.Characters(j1, 1).Font.Name = "Times New Roman"
    End Select
    Next j1
    Next j
    Next i
    End Sub


这段代码是应用于excel中的，但是在word当中呢？
我要如何用代码遍历word当中所有的文字呢？
如何用代码应用它的字体呢？
我希望是中文用的是『华文细黑』，英文用的是『times new roman』，数字用的是『Arial』,并且希望是在保存的时候能够启用宏，对全文进行刷一遍，这样的代码要怎样写才合适呢？

shenghua8

1. 
   
2. Public WithEvents appWord As Word.Application
   
3. Private Sub appWord_DocumentBeforeSave(ByVal Doc As Document, SaveAsUI As Boolean, Cancel As Boolean)
   
4.    
   
5.     Selection.HomeKey Unit:=wdStory
   
6.     Selection.WholeStory
   
7.     Selection.Find.ClearFormatting
   
8.     With Selection.Find
   
9.         .Text = "([!0-9a-zA-Z]@)"
   
10.         .Replacement.Text = "\1"
    
11.         .Forward = True
    
12.         .Wrap = wdFindContinue
    
13.         .Format = True
    
14.         .MatchCase = False
    
15.         .MatchWholeWord = False
    
16.         .MatchByte = False
    
17.         .MatchAllWordForms = False
    
18.         .MatchSoundsLike = False
    
19.         .MatchWildcards = True
    
20.     End With
    
21.     Selection.Font.Name = "华文细黑"
    
22.    
    
23.     Selection.HomeKey Unit:=wdStory
    
24.     Selection.WholeStory
    
25.     Selection.Find.ClearFormatting
    
26.     With Selection.Find
    
27.         .Text = "([a-zA-Z]@)"
    
28.         .Replacement.Text = "\1"
    
29.         .Forward = True
    
30.         .Wrap = wdFindContinue
    
31.         .Format = True
    
32.         .MatchCase = False
    
33.         .MatchWholeWord = False
    
34.         .MatchByte = False
    
35.         .MatchAllWordForms = False
    
36.         .MatchSoundsLike = False
    
37.         .MatchWildcards = True
    
38.     End With
    
39.     Selection.Font.Name = "Times New Roman"
    
40.    
    
41.     Selection.HomeKey Unit:=wdStory
    
42.     Selection.WholeStory
    
43.     Selection.Find.ClearFormatting
    
44.     With Selection.Find
    
45.         .Text = "([0-9]@)"
    
46.         .Replacement.Text = "\1"
    
47.         .Forward = True
    
48.         .Wrap = wdFindContinue
    
49.         .Format = True
    
50.         .MatchCase = False
    
51.         .MatchWholeWord = False
    
52.         .MatchByte = False
    
53.         .MatchAllWordForms = False
    
54.         .MatchSoundsLike = False
    
55.         .MatchWildcards = True
    
56.     End With
    
57.     Selection.Font.Name = "Arial"
    
58.    
    
59.     Selection.HomeKey Unit:=wdStory
    
60. End Sub
    

复制代码

楼主是高手，自己整理一下。

andy800529

shenghua8 发表于 2015-10-10 11:03
楼主是高手，自己整理一下。

非常感谢你！细心消化中。

andy800529

保存这个功能似乎无法实现，我看不出是什么问题。所以现在暂时是手动执行。

andy800529

这个代码好像还是不能分别设定英文和数字的字体。
运行了一遍下来后英文字体也被设成arial了。怎么都没有调整出来。

shenghua8

改为普通模块，可行。
即放到形如：
Sub 替换三类字体()
    ...
End Sub
里可行。

可惜Word没有Excel那样的
Private Sub Workbook_BeforeSave
事件。

用WithEvents也不行。
所以说，你是高手，请你自己整理。

shenghua8

算了。
我是手工操作录制的宏，果然没用。

手工操作是这样的：
分三次查找，每次将查找所选定的内容，换个字体。

第一次查找：

1. ([!0-9a-zA-Z]@)

复制代码

勾上“使用通配符”，
查找主文档。
这时查找到的是：非半角字母、非半角数字（即汉字及其它）。
手工改变字体为"华文细黑"。
如图：


第二次查找：

1. ([a-zA-Z]@)

复制代码

勾上“使用通配符”，
查找主文档。
这时查找到的是：半角字母。
手工改变字体为"Times New Roman"。

第三次查找：

1. ([0-9]@)

复制代码

勾上“使用通配符”，
查找主文档。
这时查找到的是：半角数字。
手工改变字体为"Arial"。


.

andy800529

shenghua8 发表于 2015-10-12 14:56
算了。
我是手工操作录制的宏，果然没用。

厉害厉害。真的挺难的，这个问题早几年有人提出来。但似乎还没有高手把它给解决掉。
我一看那么多代码，全部看不懂。
主要思路还是查找替换啊。

shenghua8

andy800529 发表于 2015-10-12 15:19
厉害厉害。真的挺难的，这个问题早几年有人提出来。但似乎还没有高手把它给解决掉。
我一看那么多代码， ...

让你见笑了！也耽误你时间了。

我不懂VBA。
查找、替换，录制的宏，经常搞不成。

413191246se

* 看楼主和升华（shenghua8）朋友讨论得很热烈，开始没敢参与，怕抢 升华 的风采！
* 但为了方便楼主工作（其实我个人倒是倾向于不必设置英文字母包括数字设置为 Arial字体，默认新罗马挺好），我也调试了一段小程序，请楼主测试一下（下面的代码不包括全角数字，并且对所有文档在退出时发生作用，但必须在询问保存时选择“是”才发挥作用！）
Sub AutoClose()
    Selection.WholeStory
    Selection.Font.NameFarEast = "华文细黑"
    Selection.Font.NameAscii = "Times New Roman"
    Selection.HomeKey Unit:=wdStory
    Do
        Selection.Find.ClearFormatting
        Selection.Find.Execute findtext:="^#"
        If Selection.Find.Found = True Then Selection.Font.Name = "Arial"
    Loop Until Selection.Find.Found = False
End Sub