d文字

1
Sub 宋体宋体(control As IRibbonControl)
2
    '选中范围字体为宋体+宋体
3
    With Selection.Font
4
        .NameFarEast = "宋体"
5
        .NameAscii = "宋体"
6
        .NameOther = "宋体"
7
    End With
8
End Sub
9
Sub 宋体罗马(control As IRibbonControl) '文字-宋体罗马
10
    '选中范围字体为宋体+Times
11
    With Selection.Font
12
        .NameFarEast = "仿宋"
13
        .NameAscii = "Times New Roman"
14
        .NameOther = "Times New Roman"
15
    End With
16
End Sub
17
Sub 楷体加粗(control As IRibbonControl) '文字-楷体加粗
18
    '选中范围字体为楷体加粗
19
    With Selection.Font
20
        .NameFarEast = "楷体"
21
        .NameAscii = "楷体"
22
        .NameOther = "楷体"
23
        .Name = "楷体"
24
        .Bold = True
25
    End With
26
End Sub
27
Sub 去除空白(control As IRibbonControl) '文字-去除空白
28
    '删除换行及空格
29

30
    Selection.Find.ClearFormatting   '删除空格
31
    Selection.Find.Replacement.ClearFormatting
32
    With Selection.Find
33
        .Text = " "
34
        .Replacement.Text = ""
35
        .Forward = True
36
        .Wrap = wdFindStop
37
        .Format = False
38
        .MatchCase = False
39
        .MatchWholeWord = False
40
        .MatchByte = True
41
        .MatchWildcards = False
42
        .MatchSoundsLike = False
43
        .MatchAllWordForms = False
44
    End With
45
    Selection.Find.Execute Replace:=wdReplaceAll
46

47
    Selection.Find.ClearFormatting   '删除大空格
48
    Selection.Find.Replacement.ClearFormatting
49
    With Selection.Find
50
        .Text = "　"
51
        .Replacement.Text = ""
52
        .Forward = True
53
        .Wrap = wdFindStop
54
        .Format = False
55
        .MatchCase = False
56
        .MatchWholeWord = False
57
        .MatchByte = True
58
        .MatchWildcards = False
59
        .MatchSoundsLike = False
60
        .MatchAllWordForms = False
61
    End With
62
    Selection.Find.Execute Replace:=wdReplaceAll
63

64
    Selection.Find.Replacement.ClearFormatting    '删除连续两个回车
65
    With Selection.Find
66
        .Text = "^p^p"
67
        .Replacement.Text = "^p"
68
        .Forward = True
69
        .Wrap = wdFindStop
70
        .Format = False
71
        .MatchCase = False
72
        .MatchWholeWord = False
73
        .MatchByte = True
74
        .MatchWildcards = False
75
        .MatchSoundsLike = False
76
        .MatchAllWordForms = False
77
    End With
78
    Selection.Find.Execute Replace:=wdReplaceAll
79
End Sub
80
Sub 中英文标点互换(control As IRibbonControl) ' 文字-中英文标点互换
81
    Dim ChineseInterpunction() As Variant, EnglishInterpunction() As Variant
82
    Dim myArray1() As Variant, myArray2() As Variant, strFind As String, strRep As String
83
    Dim msgResult As VbMsgBoxResult, n As Byte
84
    ' 定义一个中文标点的数组对象
85
    ChineseInterpunction = Array("，", "。", "；", "：", "？", "！", "……", "—", "～", "（", "）", "《", "》")
86
    ' 定义一个英文标点的数组对象
87
    EnglishInterpunction = Array(",", ".", ";", ":", "?", "!", "…", "-", "~", "(", ")", "<", ">")
88
    ' 提示用户交互的 MSGBOX 对话框
89
    msgResult = MsgBox("您想中英标点互换吗？按 Y 将中文标点转为英文标点，按 N 将英文标点转为中文标点！", vbYesNoCancel)
90
    Select Case msgResult
91
        Case vbCancel
92
            Exit Sub ' 如果用户选择了取消按钮，则退出程序运行
93
        Case vbYes ' 如果用户选择了 YES, 则将中文标点转换为英文标点
94
            myArray1 = ChineseInterpunction
95
            myArray2 = EnglishInterpunction
96
            strFind = "“(*)”"
97
            strRep = """\1"""
98
        Case vbNo ' 如果用户选择了 NO, 则将英文标点转换为中文标点
99
            myArray1 = EnglishInterpunction
100
            myArray2 = ChineseInterpunction
101
            strFind = """(*)"""
102
            strRep = "“\1”"
103
    End Select
104
    Application.ScreenUpdating = False ' 关闭屏幕更新
105
    For n = 0 To UBound(ChineseInterpunction)  ' 从数组的下标到上标间作一个循环
106
        With Selection.Find
107
            .ClearFormatting ' 不限定查找格式
108
            .MatchWildcards = False ' 不使用通配符
109
            ' 查找相应的英文标点，替换为对应的中文标点
110
            .Execute findtext:=myArray1(n), replacewith:=myArray2(n), Replace:=wdReplaceAll
111
        End With
112
    Next
113
    With Selection.Find
114
        .ClearFormatting ' 不限定查找格式
115
        .MatchWildcards = True ' 使用通配符
116
        .Execute findtext:=strFind, replacewith:=strRep, Replace:=wdReplaceAll
117
    End With
118
    Application.ScreenUpdating = True ' 恢复屏幕更新
119
End Sub
120
Sub 高亮(control As IRibbonControl) '文字-HighLight
121
    If Selection.Range.HighlightColorIndex = 0 Then
122
        Selection.Range.HighlightColorIndex = wdYellow
123
    Else
124
        Selection.Range.HighlightColorIndex = wdNoHighlight
125
    End If
126
End Sub