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