使用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-91,)。(0-91,) .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-91)(0-91) .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-E1) .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 iEnd Sub