參考http://blog.csdn.net/woohello/article/details/7621651，向原作者致敬。更改了部分vba代碼，適用於vbnet，修改不全，僅常用的。
保存到Normal.dotm裏，新建個模塊：
'script to high light code In document
Private Function isKeyword(w) As Boolean
Dim keys As New Collection
With keys
.Add " If": .Add "Else": .Add "Switch":.Add "Case": .Add "Default": .Add "Break"
.Add "Goto": .Add "Return": .Add "For":.Add "While": .Add "Do": .Add "Continue"
.Add "As": .Add "SizeOf": .Add "NULL":.Add "New": .Add "Delete": .Add "Throw"
.Add "Try": .Add "Catch": .Add "Each":.Add "Operator": .Add "Class": .Add "Me"
.Add "Ctype": .Add "Select": .Add "Case":.Add "Continue": .Add "Sub": .Add "Function"
.Add "End": .Add "Imports": .Add "Loop":.Add "GetType": .Add "And": .Add "AndAlso"
.Add "Or": .Add "OrElse": .Add "Not": .Add"Nothing": .Add "True": .Add "False"
.Add "Then": .Add "Else": .Add "Exit"
End With
isKeyword = isSpecial(w, keys)
End Function
Private Function isSpecial(ByVal w AsString, ByRef col As Collection) As Boolean
For Each i In col
If w = i Then
isSpecial = True
Exit Function
End If
Next
isspeical = False
End Function
Private Function isOperator(w) As Boolean
Dim ops As New Collection
With ops
.Add "+": .Add "-": .Add "*": .Add"/": .Add "&": .Add "^": .Add ";"
.Add "%": .Add "#": .Add "!": .Add":": .Add ",": .Add "."
.Add "||": .Add "&&": .Add "|":.Add "=": .Add "++": .Add "--"
.Add "'": .Add """"
End With
isOperator = isSpecial(w, ops)
End Function
Private Function isType(ByVal w As String)As Boolean
Dim types As New Collection
With types
.Add "Double": .Add "Structure": .Add"Enum": .Add "Single": .Add "String": .Add"Integer": .Add "Private"
.Add "Public": .Add "Friend": .Add"Protected": .Add "MustOverrides": .Add"Overrides": .Add "OverLoads": .Add "Char"
.Add "My": .Add "DataRow": .Add"TimeSpan": .Add "DataTime": .Add "Boolean": .Add"Class": .Add " Dim"
.Add "Form": .Add "DataTable": .Add"Int16": .Add "Control": .Add "Array": .Add"virtual"
.Add "List": .Add "Exception": .Add"StringBuilder"
End With
isType = isSpecial(w, types)
End Function
Public Sub SyntaxHighlight()
Dim wordCount As Integer
Dim d As Integer
'set the style of selection
'Selection.Style = "SyntexCode"
d= 0
wordCount = Selection.Words.Count
Selection.StartOf wdWord
While d < wordCount
d = d + Selection.MoveRight(wdWord, 1, wdExtend)
w = Selection.Text
If isKeyword(Trim(w)) = True Then
Selection.Font.Color = wdColorBlue
ElseIf isType(Trim(w)) = True Then
Selection.Font.Color = wdColorLightBlue
Selection.Font.Bold = True
ElseIf isOperator(Trim(w)) = True Then
Selection.Font.Color = wdColorBrown
ElseIf Trim(w) = "//"Then
'lIne comment
Selection.MoveEnd wdLine, 1
commentWords = Selection.Words.Count
d = d + commentWords
Selection.Font.Color = wdColorGreen
Selection.MoveStart wdWord, commentWords
ElseIf Trim(w) = "/*" Then
'block comment
While Selection.Characters.Last <> "/"
Selection.MoveLeft wdCharacter,1, wdExtend
Selection.MoveEndUntil("*")
Selection.MoveRightwdCharacter, 2, wdExtend
Wend
commentWords = Selection.Words.Count
d = d + commentWords
Selection.Font.Color = wdColorGreen
Selection.MoveStart wdWord, commentWords
End If
'move the start of selection to next word
Selection.MoveStart wdWord
Wend
'prepare For set lIne number
Selection.MoveLeft wdWord, wordCount, wdExtend
SetLIneNumber
End Sub
Private Sub SetLIneNumber()
Dim lines As Integer
lines = Selection.Paragraphs.Count
Selection.StartOf wdParagraph
For l = 1 To lines
lIneNum = l & " "
If l < 10 Then
lIneNum = lIneNum & " "
End If
Selection.Text = lIneNum
Selection.Font.Bold = False
Selection.Font.Color = wdColorAutomatic
p = Selection.MoveDown(wdLine, 1, wdMove)
Selection.StartOf wdLine
Next l
End Sub
End Sub