求助如何完成含有纯英文段落、纯汉文段落以及英汉混杂段落的文档字体的修改？

wdpfox

求助如何完成含有纯英文段落、纯汉文段落以及英汉混杂段落的文档字体的修改？

我试了如下宏，情况如下，见附件说明：

Subtest1()

    ActiveDocument.Content.InsertBefore vbCr

   

    Dim myRange As Range

   

    Set myRange = ActiveDocument.Content

    myRange.Find.ClearFormatting

   

    Do WhilemyRange.Find.Execute(FindText:="(^13)([!A-Za-z]@)(^13)([!A-Za-z]@)(^13)",Wrap:=wdFindStop, Format:=False, MatchWildcards:=True)

        

        myRange.CharacterWidth =wdWidthFullWidth

        

        myRange.Font.Name = "宋体"

        myRange.Font.Size = 10.5

        myRange.Font.Italic = False

        myRange.Font.Bold = False

        

    Set myRange =ActiveDocument.Range(myRange.End, ActiveDocument.Content.End)

      

    Loop

   

    Do WhilemyRange.Find.Execute(FindText:="(^13)([!A-Za-z]@)(^13)",Wrap:=wdFindStop, Format:=False, MatchWildcards:=True)

        

        myRange.CharacterWidth =wdWidthFullWidth

        

        myRange.Font.Name = "宋体"

        myRange.Font.Size = 10.5

        myRange.Font.Italic = False

        myRange.Font.Bold = False

        

    Set myRange =ActiveDocument.Range(myRange.End, ActiveDocument.Content.End)

      

    Loop

   

   

    ActiveDocument.Paragraphs(1).Range.Text =Empty

   

EndSub

Subtest2()

    ActiveDocument.Content.InsertBefore vbCr

   

    Dim myRange As Range

   

    Set myRange = ActiveDocument.Content

    myRange.Find.ClearFormatting

   

    Do WhilemyRange.Find.Execute(FindText:="(^13)([!A-Za-z]@)(^13)",Wrap:=wdFindStop, Format:=False, MatchWildcards:=True)

        

        myRange.CharacterWidth =wdWidthFullWidth

        

        myRange.Font.Name = "宋体"

        myRange.Font.Size = 10.5

        myRange.Font.Italic = False

        myRange.Font.Bold = False

        

    Set myRange =ActiveDocument.Range(myRange.End, ActiveDocument.Content.End)

      

    Loop

   

   

    Do WhilemyRange.Find.Execute(FindText:="(^13)([!A-Za-z]@)(^13)([!A-Za-z]@)(^13)",Wrap:=wdFindStop, Format:=False, MatchWildcards:=True)

        

        myRange.CharacterWidth =wdWidthFullWidth

        

        myRange.Font.Name = "宋体"

        myRange.Font.Size = 10.5

        myRange.Font.Italic = False

        myRange.Font.Bold = False

        

    Set myRange =ActiveDocument.Range(myRange.End, ActiveDocument.Content.End)

      

    Loop

   

    ActiveDocument.Paragraphs(1).Range.Text =Empty

   

EndSub

413191246se

楼主，基于简化代码，简化操作的目的，我只针对英文、中文设置了一下，我认为中英混杂段落也算中文段落，代码如下，希望能给你一些启发：

1. Sub 中英文字体设置()
   
2.     Dim i As Paragraph
   
3.     For Each i In ActiveDocument.Paragraphs
   
4.         With i.Range.Font
   
5.             If Asc(i.Range) > 0 Then '英文
   
6.                 .Italic = True
   
7.                 .Color = wdColorRed '红色
   
8.             Else '中文
   
9.                 .Name = "宋体"
   
10.                 .Italic = False
    
11.                 .Color = wdColorBlue '蓝色
    
12.             End If
    
13.             .Name = "Times New Roman"
    
14.             .Size = 16
    
15.         End With
    
16.     Next
    
17. End Sub

复制代码

wdpfox

谢谢，明天我试一下

wdpfox

413191246se 发表于 2018-2-28 10:35
楼主，基于简化代码，简化操作的目的，我只针对英文、中文设置了一下，我认为中英混杂段落也算中文段落，代 ...

经过测试，这个程序是以首字来判断的，当首字为英文字母时，整个段落被标记为英文，反之为汉语段落。