MS Word VBA to Format T-SQL Text as Rich Text

,

This VBA script was written for MS Word. It formats the text and sets default colors for keywords. SQL 2005's Management Studio now does this by default but the previous Query Analyzer did not offer this functionality. This is useful if you prefer to print and review code from time to time (not recommended for printing all scripts due to the cost of color printing). All you have to do is create a macro/module and drop the code in. You can create a button on one of your menus to be able to quickly access it. The code also offers the best rendition of page formatting that I could come up with, considering that MS Word text differs slightly from Query Analyzer, as an option/prompt when running the code.

Sub T_SQL_Format()
'
' T_SQL_Highlight Macro
' Macro created 2/26/2003 by Steven Kielkucki
'

Dim strTxtToFind As String, iAnswer As Integer
Dim i As Integer
    
iAnswer = MsgBox("Would you like to set margins to reflect MSSQL Query Analyzer printing? Clicking 'Cancel' will cancel the macro.", vbYesNoCancel, "T-SQL Format Macro")
'2 = Cancel, 6 = Yes, 7 = No for vbYesNoCancel

If iAnswer = 2 Then
MsgBox "T-SQL Format Macro Cancelled."
End
End If


'Move text down 4 lines leaving original formatting intact for the 1st 3 lines
Selection.HomeKey Unit:=wdStory
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
Selection.TypeParagraph
    
'Change font from the fourth line down to Courier
Selection.HomeKey Unit:=wdStory
Selection.MoveDown Unit:=wdLine, Count:=4
Selection.EndKey Unit:=wdStory, Extend:=wdExtend
With Selection.Font
    .Name = "courier new"
    .Color = wdColorAutomatic
    .Size = 10
End With
Selection.HomeKey Unit:=wdStory

'What a PITA it was to figure out how to find whether words were preceded or succeeded
' by an underscore. Spent (too) much time trying to look at characters before and
' after the word I was trying to update to ensure that when a change was being made
' for the word "INSERT" that it was not also being made to something like usp_INSERT_text.
' Tried many ways to accomplish this and was ending up with substantial amounts of code
' to do it. Then it hit me ..."Why not just make it look like it's a larger/different
' word?" Found that it was easier just to surround all underscores w/ a couple of "zz"
' and then later remove them when all updates had been made.

Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = "_"
    .Replacement.Text = "zz_zz"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchWholeWord = True
    .Execute Replace:=wdReplaceAll
End With

' Surround all at signs w/ 2 z's to address keywords that are used as variables
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = "@"
    .Replacement.Text = "zz@zz"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchWholeWord = True
    .Execute Replace:=wdReplaceAll
End With

Selection.HomeKey Unit:=wdStory

' Find double-dash straight line comments (teal highlight)
Do While Selection.Font.Color <> wdColorTeal
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "--"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
    End With
    With Selection
        .MoveEndUntil Cset:=Chr(13), Count:=wdForward
        .MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    End With
    Selection.Font.Color = wdColorTeal
    Selection.EndOf
    Selection.Previous(Unit:=wdWord, Count:=1).Select
    Selection.Find.Execute
Loop
Selection.HomeKey Unit:=wdStory, Extend:=wdMove

' Find Open comment / Close comment (/* to */; teal highlight)
With Selection.Find
        .Text = "/*"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
End With
Selection.Find.Execute
Do While Selection.Text = "/*"
    Selection.Find.ClearFormatting
    Selection.ExtendMode = True
    With Selection.Find
        .Text = "*/"
        .Forward = True
        .Wrap = wdFindStop
        .Execute
    End With
    Selection.Font.Color = wdColorTeal
    Selection.EndOf
    Selection.Find.Text = "/*"
    Selection.Find.Execute
Loop
Selection.HomeKey Unit:=wdStory, Extend:=wdMove


'Find all literal text (single-quotes; red highlight)
LiteralText:
With Selection.Find
    .Text = "'"
    .Font.Color = wdColorAutomatic
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
End With
Selection.Find.Execute
Do While Selection.Font.Color = wdColorAutomatic  '.Text = "'"
'    Selection.Find.ClearFormatting
    With Selection
        .MoveEndUntil Cset:="'", Count:=wdForward
        .MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    End With
    Selection.Font.Color = wdColorRed
    Selection.Move Unit:=wdCharacter, Count:=1
    Selection.Find.Execute
    If Selection.Text <> "'" Then
        Selection.MoveUntil Cset:="'", Count:=wdForward
    End If
Loop
Selection.HomeKey Unit:=wdStory, Extend:=wdMove



' ------------------------ Beginning of Blue
Selection.HomeKey Unit:=wdStory, Extend:=wdMove
i = 1
Do While i < 171

Select Case i
    Case 1
        strTxtToFind = "MIN"
    Case 2
        strTxtToFind = "SELECT"
    Case 3
        strTxtToFind = "GRANT"
    Case 4
        strTxtToFind = "UPDATE"
    Case 5
        strTxtToFind = "AS"
    Case 6
        strTxtToFind = "ORDER BY"
    Case 7
        strTxtToFind = "WHERE"
    Case 8
        strTxtToFind = "FIRST"
    Case 9
        strTxtToFind = "LAST"
    Case 10
        strTxtToFind = "TOP"
    Case 11
        strTxtToFind = "UPDATE"
    Case 12
        strTxtToFind = "int"
    Case 13
        strTxtToFind = "OUTPUT"
    Case 14
        strTxtToFind = "INTO"
    Case 15
        strTxtToFind = "INSERT"
    Case 16
        strTxtToFind = "DATE"
    Case 17
        strTxtToFind = "SET"
    Case 18
        strTxtToFind = "FROM"
    Case 19
        strTxtToFind = "GROUP BY"
    Case 20
        strTxtToFind = "HAVING"
    Case 21
        strTxtToFind = "OPENQUERY"
    Case 22
        strTxtToFind = "WHEN"
    Case 23
        strTxtToFind = "THEN"
    Case 24
        strTxtToFind = "DECLARE"
    Case 25
        strTxtToFind = "WHILE"
    Case 26
        strTxtToFind = "BEGIN"
    Case 27
        strTxtToFind = "NOCOUNT"
    Case 28
        strTxtToFind = "WITH"
    Case 29
        strTxtToFind = "ON"
    Case 30
        strTxtToFind = "CREATE "
    Case 31
        strTxtToFind = "DROP"
    Case 32
        strTxtToFind = "TABLE"
    Case 33
        strTxtToFind = "ENCRYPTION"
    Case 34
        strTxtToFind = "PROC"
    Case 35
        strTxtToFind = "PROCEDURE "
    Case 36
        strTxtToFind = "COLUMN"
    Case 37
        strTxtToFind = "varchar"
    Case 38
        strTxtToFind = "char"
    Case 39
        strTxtToFind = "DBCC"
    Case 40
        strTxtToFind = "bit"
    Case 41
        strTxtToFind = "decimal"
    Case 42
        strTxtToFind = "numeric"
    Case 43
        strTxtToFind = "smallint"
    Case 44
        strTxtToFind = "bigint"
    Case 45
        strTxtToFind = "tinyint"
    Case 46
        strTxtToFind = "sql_variant"
    Case 47
        strTxtToFind = "money"
    Case 48
        strTxtToFind = "smallmoney"
    Case 49
        strTxtToFind = "float"
    Case 50
        strTxtToFind = "real"
    Case 51
        strTxtToFind = "datetime"
    Case 52
        strTxtToFind = "smalldatetime"
    Case 53
        strTxtToFind = "text"
    Case 54
        strTxtToFind = "nchar"
    Case 55
        strTxtToFind = "nvarchar"
    Case 56
        strTxtToFind = "ntext"
    Case 57
        strTxtToFind = "binary"
    Case 58
        strTxtToFind = "varbinary"
    Case 59
        strTxtToFind = "image"
    Case 60
        strTxtToFind = "uniqueidentifier"
    Case 61
        strTxtToFind = "timestamp"
    Case 62
        strTxtToFind = "DELETE"
    Case 63
        strTxtToFind = "END"
    Case 64
        strTxtToFind = "DESC"
    Case 65
        strTxtToFind = "NAME"
    Case 66
        strTxtToFind = "MAX"
    Case 67
        strTxtToFind = "IF"
    Case 68
        strTxtToFind = "USE"
    Case 69
        strTxtToFind = "PRIMARY KEY"
    Case 70
        strTxtToFind = "FOREIGN KEY"
    Case 71
        strTxtToFind = "CONSTRAINT"
    Case 72
        strTxtToFind = "EXEC"
    Case 73
        strTxtToFind = "EXECUTE"
    Case 74
        strTxtToFind = "CHECK"
    Case 75
        strTxtToFind = "ALTER"
    Case 76
        strTxtToFind = "BEGIN"
    Case 77
        strTxtToFind = "TRAN"
    Case 78
        strTxtToFind = "TRANSACTION"
    Case 79
        strTxtToFind = "SAVE"
    Case 80
        strTxtToFind = "ROLLBACK"
    Case 81
        strTxtToFind = "COMMIT"
    Case 82
        strTxtToFind = "WORK"
    Case 83
        strTxtToFind = "DEFAULT"
    Case 84
        strTxtToFind = "CURSOR"
    Case 85
        strTxtToFind = "OPEN"
    Case 86
        strTxtToFind = "FETCH"
    Case 87
        strTxtToFind = "NEXT"
    Case 88
        strTxtToFind = "CLOSE"
    Case 89
        strTxtToFind = "DEALLOCATE"
    Case 90
        strTxtToFind = "TRIGGER"
    Case 91
        strTxtToFind = "AFTER"
    Case 92
        strTxtToFind = "FOR"
    Case 93
        strTxtToFind = "RAISERROR"
    Case 94
        strTxtToFind = "INDEX"
    Case 95
        strTxtToFind = "FILENAME"
    Case 96
        strTxtToFind = "SIZE"
    Case 97
        strTxtToFind = "MAXSIZE"
    Case 98
        strTxtToFind = "FILEGROWTH"
    Case 99
        strTxtToFind = "MODIFY"
    Case 100
        strTxtToFind = "FILGROUP"
    Case 101
        strTxtToFind = "TO"
    Case 102
        strTxtToFind = "FILE"
    Case 103
        strTxtToFind = "DATABASE"
    Case 104
        strTxtToFind = "IS"
    Case 105
        strTxtToFind = "RETURN"
    Case 106
        strTxtToFind = "VALUES"
    Case 107
        strTxtToFind = "ELSE"
    Case 108
        strTxtToFind = "FUNCTION"
    Case 109
        strTxtToFind = "RETURNS"
    Case 110
        strTxtToFind = "IDENTITY"
    Case 111
        strTxtToFind = "DISTINCT"
    Case 112
        strTxtToFind = "OFF"
    Case 113
        strTxtToFind = "QUOTEDzz_zzIDENTIFIER" 'Getting lazy here
    Case 114
        strTxtToFind = "ANSIzz_zzNULLS" 'Didn't feel like creating another loop for blue underscores
    Case 115
        strTxtToFind = "FASTzz_zzFORWARD"
    Case 116
        strTxtToFind = "IDENTITYzz_zzINSERT"
    Case 117
        strTxtToFind = "ANSIzz_zzPADDING"
    Case 118
        strTxtToFind = "SHOWPLANzz_zzTEXT"
    Case 119
        strTxtToFind = "TRUNCATE"
    Case 120
        strTxtToFind = "ADD"
    Case 121
        strTxtToFind = "INNER"
    Case 122
        strTxtToFind = "UNION"
    Case 123
        strTxtToFind = "CHECK"
    Case 124
        strTxtToFind = "NOCHECK"
    Case 125
        strTxtToFind = "GOTO"
    Case 126
        strTxtToFind = "STATISTICS"
    Case 127
        strTxtToFind = "DATEFORMAT"
    Case 128
        strTxtToFind = "WAITFOR"
    Case 129
        strTxtToFind = "DELAY"
    Case 130
        strTxtToFind = "TIME"
    Case 131
        strTxtToFind = "CUBE"
    Case 132
        strTxtToFind = "ROLLUP"
    Case 133
        strTxtToFind = "SQLPERF"
    Case 134
        strTxtToFind = "UNIQUE"
    Case 135
        strTxtToFind = "CLUSTERED"
    Case 136
        strTxtToFind = "NONCLUSTERED"
    Case 137
        strTxtToFind = "END"
    Case 138
        strTxtToFind = "LOCAL"
    Case 139
        strTxtToFind = "KEY"
    Case 140
        strTxtToFind = "BREAK"
    Case 141
        strTxtToFind = "CONTINUE"
    Case 142
        strTxtToFind = "FIRST"
    Case 143
        strTxtToFind = "SECOND"
    Case 144
        strTxtToFind = "LOGSPACE"
    Case 145
        strTxtToFind = "EXISTS"
    Case 146
        strTxtToFind = "HOLDLOCK"
    Case 147
        strTxtToFind = "NOLOCK"
    Case 148
        strTxtToFind = "PAGLOCK"
    Case 149
        strTxtToFind = "READCOMMITTED"
    Case 150
        strTxtToFind = "READPAST"
    Case 151
        strTxtToFind = "READUNCOMMITTED"
    Case 152
        strTxtToFind = "REPEATABLEREAD"
    Case 153
        strTxtToFind = "ROWLOCK"
    Case 154
        strTxtToFind = "SERIALIZABLE"
    Case 155
        strTxtToFind = "TABLOCK"
    Case 156
        strTxtToFind = "TABLOCKX"
    Case 157
        strTxtToFind = "UPDLOCK"
    Case 158
        strTxtToFind = "XLOCK"
    Case 159
        strTxtToFind = "CURRENT"
    Case 160
        strTxtToFind = "DROPzz_zzEXISTING"
    Case 161
        strTxtToFind = "PADzz_zzINDEX"
    Case 162
        strTxtToFind = "FILLFACTOR"
    Case 163
        strTxtToFind = "IGNOREzz_zzDUPzz_zzKEY"
    Case 164
        strTxtToFind = "STATISTICSzz_zzNORECOMPUTE"
    Case 165
        strTxtToFind = "SORTzz_zzINzz_zzTEMPDB"
    Case 166
        strTxtToFind = "REFERENCES"
    Case 167
        strTxtToFind = "CASCADE"
    Case 168
        strTxtToFind = "PRINT"
    Case 169
        strTxtToFind = "GROUPING"
    Case 170
        strTxtToFind = "INSTEAD OF"
End Select
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = strTxtToFind
    .Font.Color = wdColorAutomatic
    .Replacement.Text = strTxtToFind
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchWholeWord = True
'In reference to the MatchWholeWord property, preceding or
'subsequent underscores can isolate a word to be highlighted.
'I believe this also is true for any non-alphabetic characters.
' example: my_table will equate to two words; "my" and "table"
'           where "table" will be replaced
    .Replacement.Font.Color = wdColorBlue
    .Execute Replace:=wdReplaceAll
End With

i = i + 1
Loop
' ------------------------ End of Blue


' ------------------------ Beginning of Fuschia w/ NO underscores or at signs
Selection.HomeKey Unit:=wdStory
i = 1
Do While i < 46

Select Case i
    Case 1
        strTxtToFind = "STUFF"
    Case 2
        strTxtToFind = "CONVERT"
    Case 3
        strTxtToFind = "COUNT"
    Case 4
        strTxtToFind = "RIGHT"
    Case 5
        strTxtToFind = "AVG"
    Case 6
        strTxtToFind = "LEFT"
    Case 7
        strTxtToFind = "SUBSTRING"
    Case 8
        strTxtToFind = "LEN"
    Case 9
        strTxtToFind = "UPPER"
    Case 10
        strTxtToFind = "LOWER"
    Case 11
        strTxtToFind = "CHARINDEX"
    Case 12
        strTxtToFind = "PATINDEX"
    Case 13
        strTxtToFind = "CASE"
    Case 14
        strTxtToFind = "DATEADD"
    Case 15
        strTxtToFind = "DATEDIFF"
    Case 16
        strTxtToFind = "DATENAME"
    Case 17
        strTxtToFind = "DATEPART"
    Case 18
        strTxtToFind = "DAY"
    Case 19
        strTxtToFind = "MONTH"
    Case 20
        strTxtToFind = "YEAR"
    Case 21
        strTxtToFind = "GETDATE"
    Case 22
        strTxtToFind = "DATALENGTH"
    Case 23
        strTxtToFind = "CAST"
    Case 24
        strTxtToFind = "SPACE"
    Case 25
        strTxtToFind = "REPLACE"
    Case 26
        strTxtToFind = "RTRIM"
    Case 27
        strTxtToFind = "LTRIM"
    Case 28
        strTxtToFind = "QUOTENAME"
    Case 29
        strTxtToFind = "ASCII"
    Case 30
        strTxtToFind = "DIFFERENCE"
    Case 31
        strTxtToFind = "SOUNDEX"
    Case 32
        strTxtToFind = "STR"
    Case 33
        strTxtToFind = "ISNUMERIC"
    Case 34
        strTxtToFind = "ISDATE"
    Case 35
        strTxtToFind = "ISNULL"
    Case 36
        strTxtToFind = "NULLIF"
    Case 37
        strTxtToFind = "OBJECTPROPERTY"
    Case 38
        strTxtToFind = "CEILING"
    Case 39
        strTxtToFind = "REVERSE"
    Case 40
        strTxtToFind = "UNICODE"
    Case 41
        strTxtToFind = "REPLICATE"
    Case 42
        strTxtToFind = "COALESCE"
    Case 43
        strTxtToFind = "LOG"
    Case 44
        strTxtToFind = "SUM"
    Case 45
        strTxtToFind = "VAR"
End Select
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = strTxtToFind
    .Font.Color = wdColorAutomatic
    .Replacement.Text = strTxtToFind
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchWholeWord = True
    .Replacement.Font.Color = wdColorPink
    .Execute Replace:=wdReplaceAll
End With

i = i + 1
Loop
' ------------------------ End of Fuschia w/ NO underscores or at signs

' ------------------------ Beginning of Gray40
Selection.HomeKey Unit:=wdStory
i = 1
Do While i < 20

Select Case i
    Case 1
        strTxtToFind = "NULL"
    Case 2
        strTxtToFind = "NOT"
    Case 3
        strTxtToFind = "LIKE"
    Case 4
        strTxtToFind = "OUTER"
    Case 5
        strTxtToFind = "JOIN"
    Case 6
        strTxtToFind = "("
    Case 7
        strTxtToFind = "AND"
    Case 8
        strTxtToFind = ")"
    Case 9
        strTxtToFind = "<"
    Case 10
        strTxtToFind = ">"
    Case 11
        strTxtToFind = ","
    Case 12
        strTxtToFind = "IN"
    Case 13
        strTxtToFind = "="
    Case 14
        strTxtToFind = "OR"
    Case 15
        strTxtToFind = "!"
    Case 16
        strTxtToFind = "*"
    Case 17
        strTxtToFind = "+"
    Case 18
        strTxtToFind = "%"
    Case 19
        strTxtToFind = "ALL"
End Select
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = strTxtToFind
    .Font.Color = wdColorAutomatic
    .Replacement.Text = strTxtToFind
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchWholeWord = True
    .Replacement.Font.Color = wdColorGray40
    .Execute Replace:=wdReplaceAll
End With

i = i + 1
Loop
' ------------------------ End of Gray40

' ------------------------ Beginning of Green
Selection.HomeKey Unit:=wdStory
i = 1
Do While i < 14

Select Case i
    Case 1
        strTxtToFind = "sysobjects"
    Case 2
        strTxtToFind = "sysusers"
    Case 3
        strTxtToFind = "syscolumns"
    Case 4
        strTxtToFind = "sysindexes"
    Case 5
        strTxtToFind = "syscomments"
    Case 6
        strTxtToFind = "syslogins"
    Case 7
        strTxtToFind = "sysprocesses"
    Case 8
        strTxtToFind = "sysdatabases"
    Case 9
        strTxtToFind = "sysfiles"
    Case 10
        strTxtToFind = "sysindexkeys"
    Case 11
        strTxtToFind = "sysjobhistory"
    Case 12
        strTxtToFind = "sysjobs"
    Case 13
        strTxtToFind = "systypes"
End Select
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = strTxtToFind
    .Font.Color = wdColorAutomatic
    .Replacement.Text = strTxtToFind
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchWholeWord = True
    .Replacement.Font.Color = wdColorGreen
    .Execute Replace:=wdReplaceAll
End With

i = i + 1
Loop
' ------------------------ End of green

Selection.HomeKey Unit:=wdStory, Extend:=wdMove

'Reset all underscores from "zz_zz" to "_"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = "zz_zz"
    .Replacement.Text = "_"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchWholeWord = True
    .Execute Replace:=wdReplaceAll
End With

Selection.HomeKey Unit:=wdStory, Extend:=wdMove

'Reset all at signs from "zz@zz" to "@"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = "zz@zz"
    .Replacement.Text = "@"
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchWholeWord = True
    .Execute Replace:=wdReplaceAll
End With




' ------------------------ Beginning of Fuschia w/ underscores or @ signs
Selection.HomeKey Unit:=wdStory
i = 1
Do While i < 25

Select Case i
    Case 1
        strTxtToFind = "COL_LENGTH"
    Case 2
        strTxtToFind = "DB_ID"
    Case 3
        strTxtToFind = "DB_NAME"
    Case 4
        strTxtToFind = "OBJECT_ID"
    Case 5
        strTxtToFind = "OBJECT_NAME"
    Case 6
        strTxtToFind = "@@SPID"
    Case 7
        strTxtToFind = "@@IDENTITY"
    Case 8
        strTxtToFind = "@@ROWCOUNT"
    Case 9
        strTxtToFind = "@@FETCH_STATUS"
    Case 10
        strTxtToFind = "@@VERSION"
    Case 11
        strTxtToFind = "@@SERVERNAME"
    Case 12
        strTxtToFind = "@@SERVICENAME"
    Case 13
        strTxtToFind = "USER_NAME"
    Case 14
        strTxtToFind = "@@CONNECTIONS"
    Case 15
        strTxtToFind = "@@LANGUAGE"
    Case 16
        strTxtToFind = "@@LANGID"
    Case 17
        strTxtToFind = "@@LOCK_TIMEOUT"
    Case 18
        strTxtToFind = "@@MAX_CONNECTIONS"
    Case 19
        strTxtToFind = "@@TOTAL_READ"
    Case 20
        strTxtToFind = "@@TOTAL_WRITE"
    Case 21
        strTxtToFind = "@@ERROR"
    Case 22
        strTxtToFind = "CURRENT_TIMESTAMP"
    Case 23
        strTxtToFind = "SYSTEM_USER"
    Case 24
        strTxtToFind = "HOST_NAME"
End Select
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = strTxtToFind
    .Font.Color = wdColorAutomatic
    .Replacement.Text = strTxtToFind
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchWholeWord = True
    .Replacement.Font.Color = wdColorPink
    .Execute Replace:=wdReplaceAll
End With

i = i + 1
Loop

' ------------------------ End of Fuschia w/ underscores or @ signs



' ------------------------ Beginning of Maroon
Selection.HomeKey Unit:=wdStory
i = 1
Do While i < 16

Select Case i
    Case 1
        strTxtToFind = "sp_MSForEachTable"
    Case 2
        strTxtToFind = "xp_sendmail"
    Case 3
        strTxtToFind = "sp_configure"
    Case 4
        strTxtToFind = "sp_dboption"
    Case 5
        strTxtToFind = "sp_columns"
    Case 6
        strTxtToFind = "sp_databases"
    Case 7
        strTxtToFind = "sp_recompile"
    Case 8
        strTxtToFind = "sp_executesql"
    Case 9
        strTxtToFind = "sp_helpdb"
    Case 10
        strTxtToFind = "xp_msver"
    Case 11
        strTxtToFind = "sp_helplogins"
    Case 12
        strTxtToFind = "sp_who"
    Case 13
        strTxtToFind = "sp_help_job"
    Case 14
        strTxtToFind = "sp_locks"
    Case 15
        strTxtToFind = "sp_rename"
End Select
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
    .Text = strTxtToFind
    .Font.Color = wdColorAutomatic
    .Replacement.Text = strTxtToFind
    .Forward = True
    .Wrap = wdFindContinue
    .Format = True
    .MatchCase = False
    .MatchWholeWord = True
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Replacement.Font.Color = wdColorDarkRed
    .Execute Replace:=wdReplaceAll
End With

i = i + 1
Loop


'Find brackets ([ to ]; black text)
With Selection.Find
        .Text = "["
        .Font.Color = wdColorAutomatic
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
End With
Selection.Find.Execute
Do While Selection.Text = "["  '.Font.Color = wdColorAutomatic
    Selection.Find.ClearFormatting
    With Selection
        .MoveEndUntil Cset:="]", Count:=wdForward
        .MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    End With
    Select Case Selection.Font.Color
    Case wdColorTeal
    Case wdColorRed
    Case Else
'    If Selection.Font.Color <> wdColorTeal Or wdColorRed Then
        Selection.Font.Color = wdColorBlack
        If Selection.Text <> "[PRIMARY]" Then
            Selection.Text = LCase(Selection.Text)
        End If
'    End If
    End Select
    Selection.EndOf
    Selection.Find.Text = "["
    Selection.Find.Execute
Loop


'Tell Word that spelling and grammar have been checked
'   - done to ignore coding
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection
    .MoveEndUntil Cset:=Chr(13), Count:=wdForward
    .MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
End With
Selection.Font.Color = wdColorAutomatic
Selection.HomeKey Unit:=wdStory
With ActiveDocument
    .SpellingChecked = True
    .GrammarChecked = True
End With

'Alter margins to the same margins as prints from Query Analyzer
If iAnswer = 6 Then '6 = yes, 7 = no for vbYesNo
With ActiveDocument.PageSetup
    .TopMargin = InchesToPoints(0.5)
    .BottomMargin = InchesToPoints(0.25)
    .LeftMargin = InchesToPoints(0.25)
    .RightMargin = InchesToPoints(0.25)
    .Gutter = InchesToPoints(0)
    .HeaderDistance = InchesToPoints(0.25)
'    .FooterDistance = InchesToPoints(0.5)
    .PageWidth = InchesToPoints(8.5)
    .PageHeight = InchesToPoints(11)
End With
End If

'Add page numbers to top right similar to Query Analyzer
If iAnswer = 6 Then
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
    Selection.TypeText Text:=vbTab & vbTab & vbTab & vbTab & "Page #"
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldPage
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdWord, Count:=3, Extend:=wdExtend
    With Selection.Range.Font
        .Name = "courier new"
        .Size = 10
'        .Color = wdColorGray45
    End With
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
Else
End
'    Selection.TypeText Text:=vbTab & vbTab & "Page #"
End If
End Sub

Rate

Share

Share

Rate