使用vba进行Word文档的数学格式设置.doc

使用vba进行Word文档的数学格式设置
李志军
使用方法：
打开word的视图菜单，选择查看宏，再选择创建宏，将下面的代码，拷贝到代码窗口，运行即可
主要功能：
处理word中，字母和数字，符合编辑规范，包括字体，字号，字形，行距等，支持基本初等函数名称，如sin,cos等
Sub SetMathStyle()

    Selection.WholeStory
    Selection.Range.CharacterWidth = wdWidthHalfWidth
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Italic = True
    With Selection.Find
        .Text = "^$"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
     Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Italic = False
    With Selection.Find
        .Text = "."
        .Replacement.Text = "．"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Italic = False
    With Selection.Find
        .Text = "^#"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Italic = False
    With Selection.Find
        .Text = ","
        .Replacement.Text = "，"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
     Selection.Find.Replacement.Font.Italic = False
    With Selection.Find
        .Text = "。"
        .Replacement.Text = "．"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
     Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        Selection.Find.Replacement.Font.Italic = False
        Selection.Find.Replacement.Font.Name = "Times New Roman"
        With Selection.Find
            .Text = "([0-9]{1,})。([0-9]{1,})"
            .Replacement.Text = "\1.\2"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchByte = False
            .MatchWildcards = True
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Italic = False
    Selection.Find.Replacement.Font.Name = "Times New Roman"
        With Selection.Find
            .Text = "([0-9]{1})．([0-9]{1})"
            .Replacement.Text = "\1.\2"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            MatchByte = False
            .MatchWildcards = True
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Italic = False
    Selection.Find.Replacement.Font.Name = "Times New Roman"
        With Selection.Find
            .Text = "([A-E]{1})．"
            .Replacement.Text = "\1．"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchByte = False
            .MatchWildcards = True
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Dim func(25) As String
    func(0) = "sin"
    func(1) = "cos"
    func(2) = "tan"
    func(3) = "cot"
    func(4) = "lg"
    func(5) = "log"
    func(6) = "cm"
    func(7) = "mol"
    func(8) = "ln"
    func(9) = "arcsin"
    func(10) = "arccos"
    func(11) = "arctan"
    func(12) = "kg"
    func(13) = "km"
    func(14) = "cosh"
    func(15) = "arg"
    func(16) = "mod"
    func(17) = "max"
    func(18) = "min"
    func(19) = "csc"
    func(20) = "sec"
    func(21) = "lim"
    func(22) = "deg"
    func(23) = "det"
    func(24) = "exp"
    For i = 0 To 24
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        Selection.Find.Replacement.Font.Italic = False
        With Selection.Find
            .Text = func(i)
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchByte = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
    Next i
     For Each p In ActiveDocument.Paragraphs
        If p.Style = "标题 1" Then
            p.Range.Bold = True
            p.Range.Font.Name = "微软雅黑"
            p.Range.Font.Size = 26
            p.Range.Font.Color = RGB(0, 112, 192)
            p.Alignment = wdAlignParagraphCenter

        ElseIf p.Style = "标题 2" Then
            p.Range.Bold = True
            p.Range.Font.Name = "黑体"
            p.Range.Font.Size = 20
            p.Range.Font.Color = RGB(112, 48, 160)
        ElseIf p.Style = "标题 3" Then
            p.Range.Bold = True
            p.Range.Font.Name = "黑体"
            p.Range.Font.Size = 19
            p.Range.Font.Color = RGB(0, 176, 240)
        Else
            p.LineSpacingRule = wdLineSpaceDouble
            p.Range.Font.NameAscii = "Times New Roman"
            p.Range.Font.NameFarEast = "微软雅黑"
            p.Range.Font.NameOther = "Times New Roman"
            p.Range.Font.Size = 10.5
        End If
    Next p
    Dim Greekletter As String
    Greekletter = "αβγδεζηθικλμνξοπρστυφχψωΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩ"
    Dim greekcount As Integer
    greekcount = Len(Greekletter)
    Dim chgreek As String
    For i = 1 To greekcount
      chgreek = Mid(Greekletter, i, 1)
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        Selection.Find.Replacement.Font.Italic = True
        Selection.Find.Replacement.Font.Name = "Symbol"
        With Selection.Find
            .Text = chgreek
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = True
            .MatchCase = False
            .MatchWholeWord = False
            .MatchByte = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Next i
End Sub