使用方法:
打开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