Option Explicit 'David McRitchie ' http://www.mvps.org/dmcritchie/excel/code/beeps.txt ' http://www.mvps.org/dmcritchie/excel/funstuff.htm 'module: beeps in personal.xls 'Can't be installed on an object module (sheet) ' Declare Function sndPlaySound32 Lib "c:\winnt\system32\winmm.dll" _' Declare Function sndPlaySound32 Lib "winmm.dll" _ Alias "sndPlaySoundA" (ByVal lpszSoundName As String, _ ByVal uFlags As Long) As Long 'your own subroutine can be called from a worksheet event macro 'Related material on sound can be found at John Walkenbach's ' Tip 59 Playing Sound From Excel ' http://www.j-walk.com/ss/excel/tips/tip59.htm 'You can record your own voice for a wave (.wav) file ' My test "Value in A1 is 100" for 2.5 seconds was 64KB 'From the window help file "Sound Recorder" use Click here button ' actually invokes sndrec32.exe ' 1) Record with round button at far right, turns RED when recording ' 2) Stop Recording with black square, just like on a VCR ' 3) Play with the PLAY button, or double click on the speaker ' 4) File, Save As, (save in appropriate file) ' Exit in normal fashion [x] ' Example of an Event Macro -- you will need to make playvalue100 in ' a regular module ' Option Explicit ' Private Sub Worksheet_SelectionChange(ByVal Target As Range) ' If Target.Address(0, 0) = "A1" And Target.Value = 100 Then ' playvalue100 ' End If ' End Sub Sub Double_beep() Call sndPlaySound32("c:\i386\ringout.wav", 0) End Sub Sub tflush_wav() ' Call sndPlaySound32("c:\winnt\system\t-flush.wav", 0) Call sndPlaySound32("t-flush.wav", 0) End Sub Sub glass_wav() Call sndPlaySound32("c:\winnt\media\microsoft office 2000\Glass.wav", 0) End Sub Sub drumroll_wav() Call sndPlaySound32("default", 0) ' Call sndPlaySound32("c:\winnt\media\microsoft office 2000\drumroll.wav", 0) End Sub Sub Whoosh_wav() Call sndPlaySound32("c:\winnt\media\microsoft office 2000\whoosh.wav", 0) End Sub Sub RingIn_wav() Call sndPlaySound32("c:\program files\netmeetingNT\ringin.wav", 0) End Sub Public Sub MakeWavFile() ' preparation: ' dir c:*.wav /s /n > c:\temp\t.txt ' dir h:*.wav /s /n >> c:\temp\t.txt Dim strPath As String Dim strFile As String Dim strTextLine As String Dim CellRow As Long Open "c:\temp\t.txt" For Input As #1 Do While Not EOF(1) Line Input #1, strTextLine If Mid(strTextLine, 2, 13) = "Directory of " Then strPath = Trim(Mid(strTextLine, 15)) & "\" GoTo loopnext End If If Mid(strTextLine, 6, 1) = "/" Then If Mid(strPath, 4, 4) = "I386" Then GoTo loopnext If Mid(strPath, 4, 6) = "DRVLIB" Then GoTo loopnext If Mid(strPath, 4, 8) = "FOCALPNT" Then GoTo loopnext strFile = Mid(strTextLine, 40) ActiveCell.Offset(CellRow, 0) = strPath & strFile ActiveCell.Offset(CellRow, 2) = strTextLine CellRow = CellRow + 1 End If loopnext: Loop Close #1 Call sndPlaySound32("tada.wav", 0) Call sndPlaySound32("C:\Aol40\filedone.wav", 0) End Sub Sub PlayWhileActive() Dim Make_A_Break 'allow change while running loopnext: If Len(Trim(ActiveCell.Value)) = 0 Then Exit Sub If Trim(ActiveCell.Offset(0, 1)) = "" Then _ Call sndPlaySound32(ActiveCell.Value, 0) Make_A_Break = DoEvents 'yield to system tasks ActiveCell.Offset(1, 0).Activate GoTo loopnext End Sub Function PlayOne() Call sndPlaySound32(ActiveCell.Value, 0) End Function '============ These would go into the sheet ===== Private Sub Worksheet_BeforeDoubleClick(ByVal Target _ As Excel.Range, Cancel As Boolean) Cancel = True 'Get out of edit mode innerfunction End Sub Private Sub innerfunction() Application.Run "personal.xls!PlayOne" Application.EnableEvents = False ActiveCell.Offset(1, 0).Activate Application.EnableEvents = True End Sub '====== no additional references required ======a Sub PlayWavFile() 'leo.heuser@get2net.dk, December 3, 2001 Dim FullFileName As String ' FullFileName = "C:\WINDOWS\MEDIA\Microsoft Office 2000\Glass.wav" FullFileName = Selection ActiveWorkbook.FollowHyperlink Address:=FullFileName End Sub