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:
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 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 SubA 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 FunctionThe 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 SubWhen the user clicks the Speak button, the PlayRange procedure is called:
Private Sub cmdSpeak_Click()
PlayRange Selection
End SubThe 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 SubThe 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 SubThe 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 SubThis 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 SubWindows 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 LongThe 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:
Copyright © 2009 O'Reilly Media, Inc.