WindowsDevCenter.com

Simple Text-To-Speech in Excel

by Steven Roman
04/01/2000

As tax time approaches, I recently spent a late night entering a whole bunch of receipts into an Excel spreadsheet. Wanting to check the accuracy of my entries, I found myself wishing for a text-to-speech program that would read the numbers back to me. Not wanting to spend money on a professional program, or hassle with the possibility that the installation of a "multimedia" program might have an adverse effect on my system (this has happened to me before), I quickly realized that I could write a simple application myself, in the form of an Excel add-in, using a little VBA, the Excel object model, and the mciSendString API multimedia function. Of course, I would need to record the digits and a few other characters as wave files. Fortunately, I had an inexpensive microphone buried somewhere in a box inside my closet.

This article describes how to create a quick-and-dirty text-to-speech application, which I call SpeechLite, in the form of an Excel add-in. Even though it does not have the feel of a professional program, it does the job quite adequately. I had so much fun creating this application that I also created a more sophisticated version. If you are interested in this version, check it out at my web site at www.romanpress.com.

Incidentally, I chose to make this application an Excel add-in (xla file) rather than an Office 2000 COM add-in so that it can be used in Excel 97 as well as Excel 2000. To install an Excel add-in, such as SpeechLite.xla, simply open Excel and choose the Add-ins item from the Tools menu. If the Speech add-in is not listed, then hit the Browse button to locate the xla file and check its check box. That's it. For more details on creating Excel add-ins let me recommend my book Writing Excel Macros, published by O'Reilly & Associates.

Figure 1 shows the main UserForm for the application.

Figure 1. The SpeakLite add-in's UserForm

From this form, you can:

Start and stop the speech process.
Set the read order to Row-By-Row or Column-By-Column.
Set a delay factor between cells.
Specify whether or not to read dollar signs and/or commas.
Set the path to the speech wave files.

The various settings are saved in a worksheet that is part of the add-in. You can see the worksheet by setting the IsAddIn property of the SpeechLite.xla workbook to False through the Properties window of the VBA project. (Be sure to set it back to True when you are done.)

The Application

The code for this add-in is quite simple. Of course, there is code in the Open and Close events of the add-in workbook to create and destroy a custom menu that provides access to the main speech form in Figure 1:

Private Sub Workbook_Open()
  CreateCustomMenuItem
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  DeleteCustomMenuItem
End Sub

A standard code module named basSpeech contains the actual menu creation/deletion code:

Option Explicit

' To communicate with WaitForkey form
Public glCurrentRow As Long
Public glCurrentCol As Long

Public gbStop As Boolean
Public gbPause As Boolean

' ---------
Sub CreateCustomMenuItem()

Dim cbc As CommandBarControl
Dim cbcCustom As CommandBarControl
Dim x As Integer
Dim sCaption As String

' Check for a menu item named Custom on the worksheet toolbar
mbCustomExisted = False
For Each cbcCustom In Application.CommandBars("Worksheet Menu Bar").Controls
   sCaption = cbcCustom.Caption
   x = InStr(sCaption, "&")
   If x > 0 Then sCaption = Left$(sCaption, x - 1) & Mid$(sCaption, x + 1)
   If sCaption = "Custom" Then
      mbCustomExisted = True
      Exit For
   End If
Next

' If it does not exist, then create it
' with a tag to use for later deleting.
If Not mbCustomExisted Then
   Set cbcCustom = Application.CommandBars( _
     "Worksheet menu bar"). _
      Controls.Add(Type:=msoControlPopup, _
      Temporary:=True)
   cbcCustom.Caption = "&Custom"
   cbcCustom.Tag = "RPICustomMenu"
End If

' Check for menu item named SpeakLite
' If not found, add it
mbSpeakExisted = False
For Each cbc In cbcCustom.Controls
   sCaption = cbc.Caption
   x = InStr(sCaption, "&")
   If x > 0 Then sCaption = Left$(sCaption, x - 1) & Mid$(sCaption, x + 1)
   If sCaption = "SpeakLite" Then
      mbSpeakExisted = True
      Exit For
   End If
Next

' Add menu item to popup menu
If Not mbSpeakExisted Then
   With cbcCustom.Controls.Add(Type:=msoControlButton, _
      Temporary:=True)
        .Caption = "Speak&Lite"
        .OnAction = "SpeakLite"
        .Tag = "RPISpeakLiteMenu"
   End With
End If

End Sub

' ---------
Sub DeleteCustomMenuItem()

' Delete the menu items if they did not exist
' prior to this add-in creating them

Dim cbc As CommandBarControl
Dim cbcCustom As CommandBarControl

' If Speak menu item existed before, do nothing.
If mbSpeakExisted Then Exit Sub

' Find Speak control
Set cbc = Application.CommandBars( _
   "Worksheet menu bar"). _
   FindControl(Type:=msoControlButton, _
   Tag:="RPISpeakLiteMenu", Recursive:=True)
' Delete it if present
If Not cbc Is Nothing Then
   cbc.Delete
End If

' If Custom menu item existed before, do nothing.
If mbCustomExisted Then Exit Sub

' Find Custom control
Set cbc = Application.CommandBars( _
   "Worksheet menu bar"). _
   FindControl(Type:=msoControlPopup, _
   Tag:="RPICustomMenu")
' Delete it if present
If Not cbc Is Nothing Then cbc.Delete

End Sub

' ---------
Public Function Speak()
frmSpeek.Show
End Function

The main code for the application is in the main form frmSpeech. The Initialize event uses the Excel object model to bind the various controls on the form to the cells in the add-in's worksheet:

Private Sub UserForm_Initialize()

' Bind the form's controls to Sheet1 on Speech.xla

Dim sSheetName As String

sSheetName = "[" & ThisWorkbook.Name & "]Sheet1!"

' Read Order
cboReadOrder.ControlSource = _
	sSheetName & Sheet1.Range("Read_Order").Address(False, False)
cboReadOrder.RowSource = _
	sSheetName & Sheet1.Range("Read_Order_Choices").Address(False, False)

' Read dollar signs
chkReadDollarSigns.ControlSource = _
	sSheetName & Sheet1.Range("Read_Dollar_Signs").Address(False, False)

' Read commas
chkReadCommas.ControlSource = _
	sSheetName & Sheet1.Range("Read_Commas").Address(False, False)

' Delay
txtDelay.ControlSource = _
	sSheetName & Sheet1.Range("Delay").Address(False, False)

' Path to wave files
txtWavePath.ControlSource = _
	sSheetName & Sheet1.Range("Wave_File_Path").Address(False, False)

End Sub

When the user clicks the Speak button, the PlayRange procedure is called:

Private Sub cmdSpeak_Click()
PlayRange Selection
End Sub

The PlayRange procedure cycles through the cells in the selection, determining whether a delay is required between rows, columns or cells:

Private Sub PlayRange(rng As Range)

Dim r As Long, c As Long
Dim cCols As Long, cRows As Long
Dim sngDelay As Single
Dim sReadOrder As String

Dim oSheet As Worksheet

cCols = rng.Columns.Count
cRows = rng.Rows.Count

' Read values from sheet
Set oSheet = ThisWorkbook.Sheets("Sheet1")
sngDelay = Val(oSheet.Range("Delay").Text)
sReadOrder = oSheet.Range("Read_Order").Text

If sReadOrder = "Row-By-Row" Then
  For r = 1 To cRows
    For c = 1 To cCols
      DoEvents
      ' Does user want to stop?
      If mbStop Then GoTo ReadNoMore
      ' Delay?
      If sngDelay <> 0 Then Delay sngDelay
      PlayString rng.Cells(r, c).Text
    Next  ' Column
  Next    ' Row
Else
  For c = 1 To cCols
    For r = 1 To cRows
      DoEvents
      ' Does user want to stop?
      If mbStop Then GoTo ReadNoMore
      ' Delay?
      If sngDelay <> 0 Then Delay sngDelay
      PlayString rng.Cells(r, c).Text
    Next    ' row
  Next    ' column
End If

PlayWave "End"
ReadNoMore:
mbStop = False
End Sub

The PlayString procedure, which is called once for each cell to be read, parses the cell's contents into individual characters and calls the PlayWave procedure to play the appropriate wave file for each character:

Private Sub PlayString(sString As String)

Dim i As Integer, sChar As String
Dim bIsNumeric As Boolean
Dim bReadDollarSigns As Boolean
Dim bReadCommas As Boolean
Dim oSheet As Worksheet

Set oSheet = ThisWorkbook.Sheets("Sheet1")

' Read values from sheet
msWavePath = oSheet.Range("Wave_File_Path").Text
If Right$(msWavePath, 1) <> "\" Then
   msWavePath = msWavePath & "\"
End If
bReadDollarSigns = oSheet.Range("Read_Dollar_Signs").Text
bReadCommas = oSheet.Range("Read_Commas").Text

' If empty string then play accordingly and exit
If sString = "" Then
   PlayWave "emptycell"
   Exit Sub
End If

bIsNumeric = IsNumeric(sString)

' If number in parentheses, replace parens by -
If (Left$(sString, 1) = "(") And _
	(Right$(sString, 1) = ")") And bIsNumeric Then
   sString = "-" & Mid$(sString, 2, Len(sString) - 2)
End If

' Read each character in sString
For i = 1 To Len(sString)
   sChar = Mid$(sString, i, 1)
   ' Read digits
   If sChar >= "0" And sChar <= "9" Then
      PlayWave sChar
   ' Read comma if requested
   ElseIf (sChar = ",") And bReadCommas Then
      PlayWave "comma"
   ' Read dollar sign if requested
   ElseIf (sChar = "$") And bReadDollarSigns Then
      PlayWave "dollars"
   ' Read .
   ElseIf sChar = "." Then
      PlayWave "point"
   ' Read +
   ElseIf sChar = "+" Then
      PlayWave "positive"
   ' Read -"
   ElseIf sChar = "-" Then
      PlayWave "negative"
   End If
Next
End Sub

The PlayWave procedure is

Private Sub PlayWave(sFile As String)

sendstr "open " & msWavePath & sFile & ".wav" & " type waveaudio alias mciSong"
sendstr "play mciSong wait"
sendstr "close mciSong"

End Sub

This procedure calls the sendstr procedure, which is where we encounter some Windows API multimedia functions:

Private Sub sendstr(mcistr As String)

' Send mci command string
' The last parameter is 0 since we do not want
' a callback notification 
mcierrornum = mciSendString(mcistr, mcireturn, 512, 0)

' Check error message
If mcierrornum <> 0 Then
   mciGetErrorString mcierrornum, mcierror, 512
   Debug.Print "Error: " & mcistr
   Debug.Print mcireturn
   Debug.Print mcierror
   Debug.Print "-----"
End If

End Sub

Windows multimedia is quite complex. Fortunately, however, there are some aspects of it that are easily accessible.

The declarations we require are

' API
Private Const mci_wait = 2

Private mcierror As String * 512
Private mcierrornum As Integer
Private mcireturn As String * 512

Private Declare Function mciSendString Lib "winmm.dll" _
	Alias "mciSendStringA" _
	(ByVal lpstrCommand As String, _
	ByVal lpstrReturnString As String, _
	ByVal uReturnLength As Long, _
	ByVal hwndCallback As Long) As Long

Private Declare Function mciGetErrorString Lib "winmm.dll" _
	Alias "mciGetErrorStringA" _
	(ByVal dwError As Long, _
	ByVal lpstrBuffer As String, _
	ByVal uLength As Long) As Long

The mciSendString function is used to send English-like string commands to a multimedia device. The sendstr procedure simply wraps the mciSendString function. To play a wave file, we must first open the "waveaudio" device and then issue a "play" command, using its alias, as follows:

sendstr "open " & msWavePath & sFile & ".wav" & " type waveaudio alias mciSong"
sendstr "play mciSong wait"

The mciSendString function can accept a wide variety of string commands, and the Microsoft MSDN Library documentation gives a complete (if often terse and confusing) account.

The rest of the code for this project is straightforward, and can be found in the SpeechLite.xla workbook.

Finally, I should mention that in case you get tired listening to my voice, you might want to record your own wave files. This can be done with Windows' built-in Sound Recorder, but this will prove to be very tedious. After giving up with the Sound Recorder, I invested in a wave-editing program called Sound Forge XP from Sonic Foundary. Thus, after all, I ended up spending some money. Fortunately, the satisfaction of writing my own little text-to-speech program (and customizing it to my own needs) made it worth the expense.

Download the add-in and wav files.

Learn more about VB from the following O'Reilly books: