word 代码修改成选择对像进行更改

lizhipei78

以下的代码 是随机修改字体及字体的大小的，我想要的结果是对我选中的文字进行更改，而不是整个word文档，大神看一下如何修改代码。我知道关键代码在这一句For Each R_Character In ActiveDocument.Characters，只要修改这个范围就好了，但是我不懂得word的vba代码，求大神修改一下。

1. Sub 字体修改()
   
2.     Dim R_Character As Range
   
3.     Dim FontSize(5)
   
4.     FontSize(1) = "16"
   
5.     FontSize(2) = "16.5"
   
6.     FontSize(3) = "15.5"
   
7.     FontSize(4) = "15.5"
   
8.     FontSize(5) = "15"
   
9.     Dim FontName(3)
   
10.     FontName(1) = "李国夫手写体"
    
11.     FontName(2) = "李国夫手写体"
    
12.     FontName(2) = "李国夫手写体"
    
13.     Dim ParagraphSpace(5)
    
14.     ParagraphSpace(1) = "16"
    
15.     ParagraphSpace(2) = "16.5"
    
16.     ParagraphSpace(3) = "15.5"
    
17.     ParagraphSpace(4) = "15.5"
    
18.     ParagraphSpace(5) = "16"
    
19.     Dim FontPosition
    
20.     FontPosition = 2
    
21.     For Each R_Character In ActiveDocument.Characters
    
22.         VBA.Randomize
    
23.         R_Character.Font.Name = FontName(Int(VBA.Rnd * 3) + 1)
    
24.         R_Character.Font.Size = FontSize(Int(VBA.Rnd * 5) + 1)
    
25.         R_Character.Font.Position = Int(VBA.Rnd * FontPosition) + 1
    
26.         R_Character.Font.Spacing = 0
    
27.     Next
    
28.     Application.ScreenUpdating = True
    
29.     For Each Cur_Paragraph In ActiveDocument.Paragraphs
    
30.         Cur_Paragraph.LineSpacing = ParagraphSpace(Int(VBA.Rnd * 5) + 1)
    
31.     Next
    
32.     Application.ScreenUpdating = True
    
33. End Sub
    
34. 
    

复制代码

谢谢了。

gwjkkkkk

应该对seletion进行修改吧，按你的代码简单修改一下。。。
Sub 字体修改()
    Dim R_Character As Range
    Dim FontSize(5)
    FontSize(1) = "16"
    FontSize(2) = "16.5"
    FontSize(3) = "15.5"
    FontSize(4) = "15.5"
    FontSize(5) = "15"
    Dim FontName(3)
    FontName(1) = "李国夫手写体"
    FontName(2) = "李国夫手写体"
    FontName(2) = "李国夫手写体"
    Dim ParagraphSpace(5)
    ParagraphSpace(1) = "16"
    ParagraphSpace(2) = "16.5"
    ParagraphSpace(3) = "15.5"
    ParagraphSpace(4) = "15.5"
    ParagraphSpace(5) = "16"
    Dim FontPosition
    FontPosition = 2
    With Selection
        VBA.Randomize
         .Font.Name = FontName(Int(VBA.Rnd * 3) + 1)
         .Font.Size = FontSize(Int(VBA.Rnd * 5) + 1)
         .Font.Position = Int(VBA.Rnd * FontPosition) + 1
         .Font.Spacing = 0
    End With
    Application.ScreenUpdating = True
    For Each Cur_Paragraph In ActiveDocument.Paragraphs
        Cur_Paragraph.LineSpacing = ParagraphSpace(Int(VBA.Rnd * 5) + 1)
    Next
    Application.ScreenUpdating = True
End Sub

lizhipei78

gwjkkkkk 发表于 2023-3-17 17:38
应该对seletion进行修改吧，按你的代码简单修改一下。。。
Sub 字体修改()
    Dim R_Character As Range ...

非常感谢
我也要学习一下word 的vba才行

lizhipei78

gwjkkkkk 发表于 2023-3-17 17:38
应该对seletion进行修改吧，按你的代码简单修改一下。。。
Sub 字体修改()
    Dim R_Character As Range ...

测试了一下，你的代码是能更改当前选择的段落，但是并没有想像中的随机变换字体，我把上面的三种字体改了，用你的代码会全部变成一种，就像自己选择字体的效果是一样的，因此你的代码实际上是没有用的
我的想法是选中，然后对选中的每一个Characters进行随机变换就好了，我上面的代码是对整个文件的Characters进行随机变换

lizhipei78

gwjkkkkk 发表于 2023-3-17 17:38
应该对seletion进行修改吧，按你的代码简单修改一下。。。
Sub 字体修改()
    Dim R_Character As Range ...

搞定了
这样子就好了，原来跟Ecxel是差不多的