Convert Symbols to Entities using Word VBA

Word VBA Symbols to Entities Conversion Program

Symbols when converted to Text (Save as Text) seldom retain the original shape. It has been a practice to convert these symbols to entities (mostly the symbol name prefixed with an ampersand and followed by a semi colon), for example, α † etc

The following code expects a tab separated text file with symbol’s character code and its corresponding entity representation. For example

176 & degree;

945 & alpha;

To know about the corresponding character code for a symbol, you can use Alt + Symbol Key. For example Alt + 0151 will give an emdash etc

Or you can check from Insert -- > Symbol

Word Insert Symbol Dialog

We read the text file using FileSystemObject’s OpenTextFile (Refer )

Set oFil = oFS.OpenTextFile("c:\testasc.txt")

and uses the Split Function to convert each line to an array of two elements and iterate through the document

Sub Convert_Symbols2Entities()

Dim MyString

Dim arFindReplace

Dim oFS As Object

On Error GoTo Err_Found

Selection.HomeKey wdStory, wdMove

Set oFS = CreateObject("Scripting.FileSystemObject")

Set oFil = oFS.OpenTextFile("c:\testasc.txt")

Do Until oFil.AtEndOfStream ' Loop until end of file.

MyString = oFil.ReadLine

' Report if the Input is not Tab Separated

If InStr(1, MyString, Chr(9)) = 0 Then

Open ActiveDocument.Path & "\" & "SymbolsError.txt" For Append As 3

Print #3, MyString & " not replaced"

Close #3

GoTo TakeNext

End If

' Split the Input to Find & Replace Text

arFindReplace = Split(MyString, Chr(9))

' Report if ASCII Value is not valid

If Val(arFindReplace(0)) = 0) Then '' Then

Open ActiveDocument.Path & "\" & "SymbolsError.txt" For Append As 3

Print #3, MyString & " ASCII Value not valid"

Close #3

GoTo TakeNext

End If

Selection.Find.ClearFormatting

Selection.HomeKey wdStory, wdMove

With Selection.Find

.Text = ChrW(Val(arFindReplace(0)))

.Replacement.Text = arFindReplace(1)

End With

Selection.Find.Execute Replace:=wdReplaceAll

TakeNext:

Loop

LastCommands:

Close #1 ' Close file.

If Not oFS Is Nothing Then Set oFS = Nothing

Exit Sub

Err_Found:

' ----------------------------

' Error Handling

' ----------------------------

If Err <> 0 Then

Debug.Assert Err.Number <> 0

MsgBox Err.Number & " " & Err.Description & " has occurred", vbCritical, "ASCII Convert"

Err.Clear

GoTo LastCommands

End If

The code uses ChrW function, which returns a String containing the Unicode character except on platforms where Unicode is not supported

How to Show File Print Setup Dialog Box using Word VBA

The following code displays the Print Setup Dialog

Sub Show_PrintSetup()

With Dialogs(wdDialogFilePrintSetup)
.Show
End With

End Sub

How to check if Selection is Within a Table using Word VBA?

How to check if Range is Within a Table using Word VBA?

I was perplexed when LakshmiSatish, a wonderful copyeditor (and a great person) instructed some rules to be applied quite differently when a selected text is within a Table. Hats-off to copyeditors; you guys simply do a great job; I am afraid if the reader will know the hard-work you put. Enough musings! How to check if our Selection.Find is inside a Word Table? The following code makes that easy

Sub Check_If_Selection_Within_Table()

If Selection.Information(wdWithInTable) = True Then

MsgBox "Selection within Table"

Else

MsgBox "Selection outside Table"

End If

End Sub

Really easy isn’t it. There are also some other parts of Text that can be ignored. How ? Bookmarks is an easy way. We will deal with it soon.

How to set and reset track changes using Word VBA

Word VBA Set / Reset TrackRevisons

When you create a macro to do some operations that are not concerned with the content of the document, it is always advisable to do it without track changes. It is also better to turn-off the changes on screen as the deleted text might interfere with the process.

When you turn off the TrackRevisons and ShowRevisions, it is always best to leave them in their old state after the operation.

The following code does exactly the same

Sub SetAndReset_TrackRevisions()

Dim bTrackRevFlag As Boolean

Dim bShowRevFlag As Boolean

bTrackRevFlag = ActiveDocument.TrackRevisions

 bShowRevFlag = ActiveDocument.ShowRevisions

ActiveDocument.TrackRevisions = False

ActiveDocument.ShowRevisions = False

' Do Some Operations

Call TagDocument

ActiveDocument.TrackRevisions = bTrackRevFlag

ActiveDocument.ShowRevisions = bShowRevFlag

End Sub

The VBA code for autotagging the document switches off the tracking and resets them to their original position after the TagDocument subroutine is executed

How to Search a specific Colored Text (Range) using Excel VBA

Search Formatted Text using Excel VBA / Extract Colored Range using Excel VBA / Excel VBA Tag Color Text

The following code identifies the Blue Color text and ‘tags’ them

Sub Tag_Blue_Color()

Dim oWS As Worksheet

Dim oRng As Range

Dim FirstUL

Set oWS = ActiveSheet

Application.FindFormat.Clear

Application.FindFormat.Font.Color = vbBlue

Set oRng = oWS.Range("A1:A1000").Find(What:="", LookIn:=xlValues, LookAt:= _

xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, SearchFormat:=True)

If Not oRng Is Nothing Then

FirstUL = oRng.Row

Do

oRng.Font.Color = vbautomatic

oRng.Value2 = "" & oRng.Value2 & ""

Set oRng = oWS.Range("A" & CStr(oRng.Row + 1) & ":A1000").Find(What:="", LookIn:=xlValues, LookAt:= _

xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, SearchFormat:=True)

Loop While Not oRng Is Nothing

End If

End Sub

In the above code we have used

Application.FindFormat.Clear

Clears the criterias set in the FindFormat property and then set the format to find using

Application.FindFormat.Font.Color = vbBlue

Formatted Text in Excel (Colored)

Convert Colored Text to Tags in Excel

Convert Formatted Text to Tags in Excel, Tag formatted text in Excel

How to Search Italic Text (Range) using Excel VBA

Search Formatted Text using Excel VBA / Extract Italicized Range using Excel VBA / Excel VBA Tag Italic Text

The following code identifies the Italic text and ‘tags’ them

Sub Tag_Italic()

Dim oWS As Worksheet

Dim oRng As Range

Dim FirstUL

Set oWS = ActiveSheet

Application.FindFormat.Clear

Application.FindFormat.Font.Italic = True

Set oRng = oWS.Range("A1:A1000").Find(What:="", LookIn:=xlValues, LookAt:= _

xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, SearchFormat:=True)

If Not oRng Is Nothing Then

FirstUL = oRng.Row

Do

oRng.Font.Italic = False ' Use this if you want to remove italics

oRng.Value2 = "" & oRng.Value2 & ""

Set oRng = oWS.Range("A" & CStr(oRng.Row + 1) & ":A1000").Find(What:="", LookIn:=xlValues, LookAt:= _

xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, SearchFormat:=True)

Loop While Not oRng Is Nothing

End If

End Sub

In the above code we have used

Application.FindFormat.Clear

Clears the criterias set in the FindFormat property and then set the format to find using

Application.FindFormat.Font.Italic = True

Italic Formatted Text in Excel

Formatted Text replaced by Tags in Excel

How to Search Bold Text (Range) using Excel VBA

Search Formatted Text using Excel VBA / Extract Boldfaced Range using Excel VBA / Excel VBA Tag Bold Text

The following code identifies the bold text and ‘tags’ them

Sub Tag_Bold()

Dim oWS As Worksheet

Dim oRng As Range

Dim FirstUL

Set oWS = ActiveSheet

Application.FindFormat.Clear

Application.FindFormat.Font.Bold = True

Set oRng = oWS.Range("A1:A1000").Find(What:="", LookIn:=xlValues, LookAt:= _

xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, SearchFormat:=True)

If Not oRng Is Nothing Then

FirstUL = oRng.Row

Do

oRng.Font.Bold = False ' Use this if you want to remove bold

oRng.Value2 = "" & oRng.Value2 & ""

Set oRng = oWS.Range("A" & CStr(oRng.Row + 1) & ":A1000").Find(What:="", LookIn:=xlValues, LookAt:= _

xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, SearchFormat:=True)

Loop While Not oRng Is Nothing

End If

End Sub

In the above code we have used

Application.FindFormat.Clear

Clears the criterias set in the FindFormat property and then set the format to find using

Application.FindFormat.Font.Bold = True

Excel with Bold Formatted Text

Excel with Tagged Text (Format)

How to Search Underlined Text (Range) using Excel VBA

Search Formatted Text using Excel VBA / Extract Underlined Range using Excel VBA / Excel VBA Tag Underlined Text

One day a strange ‘job’ landed on my director friend M.A. Keeran. He had written a beautiful script for a film in Excel and has given for a second look. The guy who had done the second parse, underlined the parts of script that needs to be retained. Now we need to extract those ranges that have underlines. The following code is the modification/extension of that: it identifies the underlined text and ‘tags’ them

Sub Tag_UnderLine()

Dim oWS As Worksheet

Dim oRng As Range

Dim FirstUL

Set oWS = ActiveSheet

Application.FindFormat.Clear

Application.FindFormat.Font.Underline = XlUnderlineStyle.xlUnderlineStyleSingle

Set oRng = oWS.Range("A1:A1000").Find(What:="", LookIn:=xlValues, LookAt:= _

xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, SearchFormat:=True)

If Not oRng Is Nothing Then

FirstUL = oRng.Row

Do

oRng.Font.Underline = XlUnderlineStyle.xlUnderlineStyleNone ' Use this if you want to remove underline in first column

oRng.Value2 = "

" & oRng.Value2 & "

"

Set oRng = oWS.Range("A" & CStr(oRng.Row + 1) & ":A1000").Find(What:="", LookIn:=xlValues, LookAt:= _

xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, SearchFormat:=True)

Loop While Not oRng Is Nothing

End If

End Sub

In the above code we have used

Application.FindFormat.Clear

Clears the criterias set in the FindFormat property and then set the format to find using

Application.FindFormat.Font.Underline = XlUnderlineStyle.xlUnderlineStyleSingle

Excel with Formatted Text (Underline)
Excel with Tags

How to use Connection events in ADO (VBA)

ADO Connection is associated with some interesting events. To consume the events, create a class and declare the Connection object

I have created a class called ClassXLApp and have created an object for Connection.

Private WithEvents CN As ADODB.Connection

WithEvents Keyword that specifies that varname is an object variable used to respond to events triggered by an ActiveX object. WithEvents is valid only in class modules. You can declare as many individual variables as you like using WithEvents, but you can't create arrays with WithEvents. You can't use New with WithEvents.

Select the Object name (CN here) in the Object Box. The Procedures/Events Box lists all the events recognized by Visual Basic for a form or control displayed in the Object box and will display all the events associated with connection

Click on any event to write the code associated with in the code window.

For example, let us use the following events

Private Sub CN_WillConnect(ConnectionString As String, UserID As String, Password As String, Options As Long, adStatus As ADODB.EventStatusEnum, ByVal pConnection As ADODB.Connection)

Debug.Print Now() & " Will connect"

End Sub

Private Sub CN_ConnectComplete(ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pConnection As ADODB.Connection)

Debug.Print Now() & " ConnectComplete"

End Sub

Private Sub CN_Disconnect(adStatus As ADODB.EventStatusEnum, ByVal pConnection As ADODB.Connection)

Debug.Print Now() & " Disconnected"

End Sub

Apart from the above three events, we can have two methods – one to connect to the database and one to disconnect from the database

Public Sub Connect2DB()

Set CN = New ADODB.Connection

CN.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\db1.mdb;Persist Security Info=False"

CN.ConnectionTimeout = 40

CN.Open

End Sub

Public Sub DisConnect()

If CN.State = adStateOpen Then

CN.Close

End If

If Not CN Is Nothing Then Set CN = Nothing

End Sub

Now let us use this class in any code module.

Sub ADODB_Connection_EXample()

Dim oCX As ClassXLApp

On Error GoTo ADO_ERROR

Set oCX = New ClassXLApp

oCX.Connect2DB

'''Code using database values

oCX.DisConnect

ADO_ERROR:

If Err <> 0 Then

Debug.Assert Err = 0

MsgBox Err.Description

Resume Next

End If

End Sub

We have created a connection and disconnected it. This will be fire the events in following order

12/4/2008 5:31:03 PM Will connect

12/4/2008 5:31:03 PM ConnectComplete

12/4/2008 5:31:03 PM Disconnected