PDA

View Full Version : Solved: Create a sound



maninjapan
04-15-2011, 06:39 AM
Im trying to create a sound warning when a cell exceeds a certain value. Learning the steps to this are as important as the final outcome for me so I plan to add to it piece by piece. First step is simply getting a beep when A1 > A2 which I have done using the following as a base. I would now like to add change the beep to a .wav file and havea message box pop up at the same time.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Integer
If Not Intersect(Target, Range("A1")) Is Nothing Then
If Target.Value < 25 Then
For x = 1 To 5
Beep
Application.Wait Now + TimeValue("00:00:01")
Next x
End If
End If
End Sub



Thanks!!

GTO
04-15-2011, 08:16 AM
Hi maninjapan,

Take a look at http://www.vbaexpress.com/kb/getarticle.php?kb_id=161

maninjapan
04-15-2011, 08:18 AM
Ok, Ive got a bit further with this. with a bit of cut and paste from another sheet I found so its probably pretty ugly but it seems to work so far. I have a sound alert with a popup window. I want the wav file to play until the popup window is closed.

Sheet 1 B6 is the cell Im working with for now.

Any help with this would be much appreciated.

Thanks!!

maninjapan
04-15-2011, 08:19 AM
GTO, thanks, looks like I posted this at the same time. I'll have a look at this too! Thanks!!

maninjapan
04-15-2011, 08:25 AM
GTO, thanks, tried this, but it with MsgBox but it only plays the file after I press ok in the message box. I'd like it to play the sound and show the message box at the same time and keep playing until OK is clicked

GTO
04-15-2011, 08:45 AM
I do not have handy how to cancel the sound. To get the box up while the sound plays, change the second arg to 1
Sub PlaySound()
'//
Call sndPlaySound32(ThisWorkbook.Path & "\LoadIt.WAV", 1)
MsgBox "HI"
End Sub

maninjapan
04-15-2011, 09:00 AM
Currently using this, looks like it is set to 1, but still playing after I click ok


Option Explicit

Private Declare Function sndPlaySound32 Lib "winmm.dll" _
Alias "sndPlaySoundA" (ByVal lpszSoundName _
As String, ByVal uFlags As Long) As Long

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Cell As Range
Dim CheckRange As Range
Dim PlaySound As Boolean

Set CheckRange = Range("B15")
For Each Cell In CheckRange
If Cell.Value > 10 Then
PlaySound = True
MsgBox "TEST MESSAGE"

End If
Next
If PlaySound Then
Call sndPlaySound32("C:\tt\sounds\imo.wav", 1)
End If

End Sub

GTO
04-15-2011, 09:16 AM
In #7 we appear to be checking B15's value each time any change is made to the sheet. Is that the goal?

GTO
04-15-2011, 09:28 AM
I hope I'm not terribly off here, but maybe:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("B15")) Is Nothing Then
If Range("B15").Value > 10 Then
Call sndPlaySound32(ThisWorkbook.Path & "\LoadIt.wav", 1&)
If MsgBox("Kill that dang sound!", vbOKOnly Or vbQuestion) = vbOK Then
Call sndPlaySound32(0&, 1&)
End If
End If
End If
End Sub
This should just fire when B15 changes (I are getting a wee bit tired), and cancel the sound if the msgbox clears before the sound ends.

maninjapan
04-15-2011, 09:46 AM
good one GTO. Nailed it!!

GTO
04-15-2011, 10:10 AM
:congaline Have a great weekend!

Kenneth Hobs
04-15-2011, 12:25 PM
To add to GTO's fine example, I added an embedded wav file method. I also tweaked GTO's code for another example to show how to loop the sound file playing and to download the file if needed.

maninjapan
04-18-2011, 07:44 AM
Thank you Kenneth, Ive been able to add the loop sound file to my code. My next question is, once the alert has been triggered and stopped I dont want it to trigger again until it has gone back below and then breached the trigger range again. (I hope this makes sense) I am using this to create a trigger for my trading P&L and only need it to go ff once per breach of the trigger level.

Thanks

Kenneth Hobs
04-18-2011, 08:12 AM
Does the Change event not meet your need?

maninjapan
04-18-2011, 08:31 AM
Kenneth, sorry if I wasnt clear. I use this as an alert for my trading PL, I just need it to alert me the first time it goes past a certain amount. Once it trips I want to just be able to turn it off and not have it trigger strainght away (the first alert already got my attention). Hope that makes sense.

If this makes the macro a lot more difficult, perhaps I could just add a 2nd condition (If B14 = "ON" or a check box or similar) that way I could just turn it on/off as I need it.

Kenneth Hobs
04-18-2011, 10:32 AM
In my routines:
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Target, Range("B15")) Is Nothing Then Exit Sub
If Range("B15").Value <= 10 And Range("B14").Value2 <> "ON" Then Exit Sub
UserForm1.Show
End Sub

Private Sub CommandButton1_Click()
tNow = 0
Unload Me
Range("B14").Value2 = "OFF"
End Sub

maninjapan
04-19-2011, 06:50 AM
Thanks again Kenneth, I tried to work that idea into the following, the idea being the alarm wont execute as long as "ON" is not entered into G2. It seems to be ignoring that however, and executing every time.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim tf As Boolean, soundFile As String
If Application.Intersect(Target, Range("B4")) Is Nothing Then Exit Sub
If Range("B4").Value > Range("G3").Value And Range("G2").Value2 <> "ON" Then Exit Sub
soundFile = "C:\tt\sounds\alarm2.wav"
Call sndPlaySound32(soundFile, SND_LOOP Or SND_ASYNC)
If MsgBox("Kill that dang sound!", vbOKOnly Or vbQuestion) = vbOK Then
Call sndPlaySound32(0&, 1&)
End If
End Sub

GTO
04-19-2011, 07:26 AM
Using Ken's wb (Nice! I don't recall seeing playing an embedded clip), and other than changing the path to the sound file, you code worked for me. If you want to 'flip a switch' once the code runs once, maybe try:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tf As Boolean, soundFile As String

If Not Application.Intersect(Target, Range("B4")) Is Nothing _
And Range("B4").Value > Range("G3").Value _
And Not Range("G2").Value = "ON" Then
Application.EnableEvents = False
Range("G2").Value = "ON"
Application.EnableEvents = True
soundFile = ThisWorkbook.Path & "\YesMaster.wav"
Call sndPlaySound32(soundFile, SND_LOOP Or SND_ASYNC)

If MsgBox("Kill that dang sound!", vbOKOnly Or vbQuestion) = vbOK Then
Call sndPlaySound32(0&, 1&)
End If
End If
End Sub

maninjapan
04-19-2011, 07:52 AM
Thanks GTO that does what I need. Now I am just having one small issue, "B4" is an RTD link that connects to my trading software. When I initially open the sheet it takes a couple of seconds to get data. Until then it shows #N/A at which time I get an error message related to the value. Is there a simple IF statement that will return '0' unless the cell returns an actual number?

Thanks

GTO
04-19-2011, 08:40 AM
I am afraid I do not have any experience (or know what it is) as to an RTD link. I presume the change event is being fired(?) rather than the calculate event. Anyways, a blind stab - maybe try testing for IsError and assign value to a variable dependant on outcome.

Dim MyVal As Double

If IsError(Range("B3")) Then
MyVal = 0
Else
MyVal = Range("B3")
End If

GTO
04-19-2011, 08:41 AM
OOps... I meant B4 of course.

maninjapan
04-19-2011, 08:47 AM
Thanks GTO, where do I need to put this ?

GTO
04-19-2011, 08:51 AM
Again, a blind stab, so definitely in a junk copy of your wb.


Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tf As Boolean, soundFile As String
Dim myVal As Double

If IsError(Range("B4")) Then
myVal = 0
Else
myVal = Range("B4").Value
End If

If Not Application.Intersect(Target, Range("B4")) Is Nothing _
And myVal > Range("G3").Value _
And Not Range("G2").Value = "ON" Then
Application.EnableEvents = False
Range("G2").Value = "ON"
Application.EnableEvents = True
soundFile = ThisWorkbook.Path & "\YesMaster.wav"
Call sndPlaySound32(soundFile, SND_LOOP Or SND_ASYNC)

If MsgBox("Kill that dang sound!", vbOKOnly Or vbQuestion) = vbOK Then
Call sndPlaySound32(0&, 1&)
End If
End If
End Sub


Hope it works,

Mark

maninjapan
04-19-2011, 09:05 AM
Thanks Mark, Just tried it, but anything but a number gives the same result. I also tried typing in a letter or other non numerical value, also giving the same result.

GTO
04-19-2011, 11:32 PM
Thanks Mark, Just tried it, but anything but a number gives the same result. I also tried typing in a letter or other non numerical value, also giving the same result.

What result?

I forced an #N/A by entering a bad MATCH() formula, and MyVal is assigned = 0

maninjapan
04-20-2011, 09:15 AM
GTO, I hadn't copied your code across properly. It works fine. Thanks a lot !

GTO
04-20-2011, 09:54 AM
:congaline I should be in Vegas, I'm on a streak:jester: Glad that worked :-)

maninjapan
04-25-2011, 08:14 AM
back with what seems to be a small kink in VBA that we have to date.
It triggers exactly as it should when i type in numbers manually to the cell.
However in reality the cell being watched is a sum of 4 other cells which show PL through a RTD link.
I fired it up for the first time today using the RTD data, but it wasn't executing ( even though the total PL was over the threshold).
If I clicked on the cell and pressed enter after the formula it recognizes the condition as being filled, but unless i do that the total PL freely moves through the threshhold without triggering the alert.
I'm not sure what is going on here, but as the macro stands does it not see that the number in the cell is actually changing?

Kenneth Hobs
04-25-2011, 08:26 AM
If it is a formula, then you need to check it at each calculate event. The sheet's Calculate event does not have a Target as an input parameter.

maninjapan
04-25-2011, 08:49 AM
sorry Kenneth, that went a bit over my head. where do I need to make the tweaks in the code GTO supplied?

Kenneth Hobs
04-25-2011, 09:35 AM
You can right click the sheet's tab and View Code and paste sheet code like that below or doubleclick the sheet object in the VBE and paste sheet code.

You should rename the Change event code or delete it so that it will not activate.

Another way to add event subs to a sheet object is to be in the sheet's code section as first detailed, select the Worksheet in the first dropdown list and the event in the second dropdown list.

Private Sub Worksheet_Calculate()
Dim tf As Boolean, soundFile As String
Dim myVal As Double

If IsError(Range("B4")) Then
myVal = 0
Else
myVal = Range("B4").Value
End If

If myVal > Range("G3").Value And Range("G2").Value <> "ON" Then
Application.EnableEvents = False
Range("G2").Value = "ON"
Application.EnableEvents = True
soundFile = ThisWorkbook.Path & "\YesMaster.wav"
Call sndPlaySound32(soundFile, SND_LOOP Or SND_ASYNC)

If MsgBox("Kill that dang sound!", vbOKOnly Or vbQuestion) = vbOK Then
Call sndPlaySound32(0&, 1&)
End If
Application.EnableEvents = True
End If
End Sub

maninjapan
04-25-2011, 10:55 AM
Sorry kenneth, now Im completely lost. I just tried adding the code you posted to the Sheet Module and it comes up with an error . Is this supposed to work as it is?

Thanks

Kenneth Hobs
04-25-2011, 11:57 AM
Saying it has an error does not help me much. Always use Option Explicit. If you don't have the Compile button on your VBE toolbar, I recommend adding it as-well-as the option to add Option Explicit for you.

To answer your question, no, it was meant to work with the module mGTO that I posted in the xlsm earlier. In it, constants and the API were defined. A compile shows error for Snd_Loop if it was not defined so that is a clue. Other errors could be that the sound file does not exist. That check can easily be added though with a Dir().

The mGTO code was:
Public Declare Function sndPlaySound32 Lib "winmm.dll" _
Alias "sndPlaySoundA" (ByVal lpszSoundName _
As String, ByVal uFlags As Long) As Long

' flag values for uFlags parameter
Public Const SND_SYNC = &H0 ' play synchronously (default)
Public Const SND_ASYNC = &H1 ' play asynchronously

Public Const SND_NODEFAULT = &H2 ' silence not default, if sound not found

Public Const SND_MEMORY = &H4 ' lpszSoundName points to a memory file
Public Const SND_ALIAS = &H10000 ' name is a WIN.INI [sounds] entry
Public Const SND_FILENAME = &H20000 ' name is a file name
Public Const SND_RESOURCE = &H40004 ' name is a resource name or atom
Public Const SND_ALIAS_ID = &H110000 ' name is a WIN.INI [sounds] entry identifier

Public Const SND_ALIAS_START = 0 ' must be > 4096 to keep strings in same section of resource file

Public Const SND_LOOP = &H8 ' loop the sound until next sndPlaySound
Public Const SND_NOSTOP = &H10 ' don't stop any currently playing sound
Public Const SND_VALID = &H1F ' valid flags / ;Internal /

Public Const SND_NOWAIT = &H2000 ' don't wait if the driver is busy

Public Const SND_VALIDFLAGS = &H17201F ' Set of valid flag bits. Anything outside
' this range will raise an error
Public Const SND_RESERVED = &HFF000000 ' In particular these flags are reserved

Public Const SND_TYPE_MASK = &H170007

maninjapan
04-26-2011, 03:59 AM
Kenneth, thank you for your patience on this. I wasn't using a copy/paste of your code as I had changed some of the conditions slightly and skipped over the change from Worksheet_Change to Corksheet_Calculate.

Your code worked perfectly once I found my own error.

Thank you again.

zman21
10-24-2012, 10:25 PM
So, when you guys say "embed" does that actually mean the sound file is stored within the worksheet? I'm trying to play a sound when an image is clicked. But, I don't want to have to store the sound file locally on the machine.

Kenneth Hobs
10-25-2012, 05:45 AM
Welcome to the forum Zman21!

Please start a new thread unless your post is to help with the current thread. Solved threads are best left alone unless the original posters (op) needs clarification or the helper has other tips. Since you have less than 5 posts, rather than posting a link to a related thread, just say my issue is similar post 37056 but I need to.....

To answer your question, yes. See my example file.