VB宏 格式化代码

OfficeCodePrettify

'script to high light code In document
' for vb script 宏

Private Function isKeyword(w) As Boolean

Dim keys As New Collection

With keys

.Add "if": .Add "else": .Add "elseif": .Add "case": .Add "switch": .Add "break"

.Add "int": .Add "double": .Add "char": .Add "long": .Add "string": .Add "template"

.Add "for": .Add "continue": .Add "do": .Add "while": .Add "foreach": .Add "echo"

.Add "define": .Add "array": .Add "NULL": .Add "function": .Add "include": .Add "return"

.Add "global": .Add "as": .Add "die": .Add "header": .Add "this": .Add "empty"

.Add "class": .Add "mysql_fetch_assoc": .Add "class": .Add "style"

.Add "name": .Add "value": .Add "type": .Add "width": .Add "_POST": .Add "_GET"

End With

isKeyword = isSpecial(w, keys)

End Function

Private Function isSpecial(ByVal w As String, 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 "SELECT": .Add "FROM": .Add "WHERE": .Add "INSERT": .Add "INTO": .Add "VALUES": .Add "ORDER"

.Add "BY": .Add "LIMIT": .Add "ASC": .Add "DESC": .Add "UPDATE": .Add "DELETE": .Add "COUNT"

.Add "html": .Add "head": .Add "title": .Add "body": .Add "p": .Add "h1": .Add " h2"

.Add "h3": .Add "center": .Add "ul": .Add "ol": .Add "li": .Add "a"

.Add "input": .Add "form": .Add "b"

End With

isType = isSpecial(w, types)

End Function

Sub SyntaxHighlight()

Dim wordCount As Integer

Dim d As Integer

' set the style of selection

Selection.Style = "Code"

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 = wdColorDarkRed

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.MoveRight wdCharacter, 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 = 0 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

End Sub