word提取所有字号

cuanju

1. Sub word文章提取所有字号_查找替换()
   
2.     Dim c As New Collection
   
3.     For i = 1 To 72 Step 0.5
   
4.         Selection.HomeKey Unit:=wdStory
   
5.         Selection.Find.ClearFormatting
   
6.         Selection.Find.Font.Size = i
   
7.         Selection.Find.Execute
   
8.         If Selection.Find.Found = True Then
   
9. '            Stop
   
10.             Select Case i
    
11.            Case 6.5
    
12.                 i2 = "小六"
    
13.                 c.Add i2
    
14.                 MsgBox i2
    
15.            Case 7.5
    
16.                 i2 = "六号"
    
17.                 c.Add i2
    
18.                 MsgBox i2
    
19.             Case 9
    
20.                 i2 = "小五"
    
21.                 c.Add i2
    
22.                 MsgBox i2
    
23.             Case 10.5
    
24.                 i2 = "五号"
    
25.                 c.Add i2
    
26.                 MsgBox i2
    
27.             Case 12
    
28.                 i2 = "小四"
    
29.                 c.Add i2
    
30.                 MsgBox i2
    
31.             Case 14
    
32.                 i2 = "四号"
    
33.                 c.Add i2
    
34.                 MsgBox i2
    
35.             Case 15
    
36.                 i2 = "小三"
    
37.                 c.Add i2
    
38.                 MsgBox i2
    
39.             Case 16
    
40.                 i2 = "三号"
    
41.                 c.Add i2
    
42.                 MsgBox i2
    
43.             Case 18
    
44.                 i2 = "小二"
    
45.                 c.Add i2
    
46.                 MsgBox i2
    
47.             Case 22
    
48.                 i2 = "二号"
    
49.                 c.Add i2
    
50.                 MsgBox i2
    
51.             Case 24
    
52.                 i2 = "小一"
    
53.                 c.Add i2
    
54.                 MsgBox i2
    
55.             Case 26
    
56.                 i2 = "一号"
    
57.                 c.Add i2
    
58.                 MsgBox i2
    
59.             Case 36
    
60.                 i2 = "小初"
    
61.                 c.Add i2
    
62.                 MsgBox i2
    
63.             Case 42
    
64.                 i2 = "初号"
    
65.                 c.Add i2
    
66.                 MsgBox i2
    
67.             Case Else
    
68.                 c.Add i
    
69.                 MsgBox i
    
70.             End Select
    
71.             'MsgBox (i2)
    
72.             
    
73.             '            Stop
    
74.             'j = j & i2 & Chr(13)
    
75.         End If
    
76.     Next i
    
77.     'Stop
    
78.     'For k = 1 To c.Count - 1
    
79.     'For k = 1 To c.Count
    
80.     For k = c.Count To 1 Step -1
    
81.         s = c(k) & " " & s
    
82.         Debug.Print c(k)
    
83.         'MsgBox c(k)
    
84.         'Stop
    
85.         c.Remove (k)
    
86.     Next
    
87.     MsgBox s, vbOKOnly, "本文包含以下字号"
    
88. End Sub

复制代码

遥控器78

可以提取所有字体吗？