Embeded Wav

D

Desert Piranha

Hi All,

In Cell C9 is the result of a sum formula.

I have tried "Worksheet_Change(ByVal Target As Range)"
and "Worksheet_SelectionChange(ByVal Target As Range)'
Both of which don't update when C9 updates.

1- Using this code below works, but with a minor problem. If i delete a
row or something like that then
the code runs, i assume cause the worksheet recalculates. A way to fix
that?

2- Also i don't want the "little speaker shape" to be visible on the
worksheet. Is there a better way than
the way i have below? It seems, it has to be visible in order to play.

3- A way to embed the wav in the workbook instead of the active sheet?
IE: so it can be called from
multiple worksheets, but not go to another worksheet.

Thx for any direction.


Code:
--------------------
Private Sub Worksheet_Calculate()
If Range("C9") > 100 Then
Call MyMacro
End If
End Sub

Sub MyMacro()
ActiveSheet.Shapes("Object 1").Visible = True

ActiveSheet.Shapes("Object 1").Select
Selection.Verb Verb:=xlPrimary

ActiveSheet.Shapes("Object 1").Visible = False

Range("D1").Activate

End Sub
 
N

Norman Jones

Hi Dave,

Try naming your cell - say: myCell - and replace your code with:

'=============>>
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range

On Error Resume Next
Set rng = Intersect(Target, Me.Range("myCell").Precedents)
On Error GoTo 0

If Not rng Is Nothing Then
Call MyMacro
End If
End Sub
'<<=============


'=============>>
Sub MyMacro()
Dim SH As Worksheet

Set SH = ThisWorkbook.Sheets("Sheet3") '<<==== CHANGE
With SH.OLEObjects("Object 3")
.Visible = False
.Verb
End With
End Sub
'<<=============


---
Regards,
Norman


"Desert Piranha"
 
D

Desert Piranha

Hi Norman,

Good to hear from you.
Good luck in the World Cup.

The code you posted hides the shape great. However i can't seem to get
the "If Greater than 100" in C9 (myCell) to work.
My head is full of air this weekend.

Here is some of the stuff have tried:


Code
-------------------
'=============>>
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range

On Error Resume Next
Set rng = Intersect(Target, Me.Range("myCell").Precedents)
''Set rng = Intersect(Target, Me.Range("myCell > 100").Precedents)
''Set rng = Intersect(Target, Me.Range("myCell" > 100).Precedents)
On Error GoTo 0

If Not rng Is Nothing Then
''If rng("myCell") > 100 Then
''If rng("myCell" > 100) Then
''If rng("myCell > 100") Then
Call MyMacro
End If
End Sub
'<<=============
'=============>>
Sub MyMacro()
Dim SH As Worksheet

Set SH = ThisWorkbook.Sheets("Sheet2") '<<==== CHANGE
With SH.OLEObjects("Object 1")
.Visible = False
.Verb
End With
End Sub
'<<============
-------------------
 
N

Norman Jones

Hi Dave,

Sorry, I overlooked the condition!

Try:

'=============>>
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range

On Error Resume Next
Set rng = Intersect(Target, Me.Range("myCell").Precedents)
On Error GoTo 0

If Not rng Is Nothing And Range("Mycell").Value > 100 Then
Call MyMacro
End If
End Sub
'<<=============
Good luck in the World Cup.

And to you!!
 
D

Desert Piranha

Hi All,

For those following the thread. Due to a really strange active cel
condition,
after the code was ran. Norman has updated it. Here is the code in it
entirety.

Code
-------------------
'=============>>
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range

On Error Resume Next
'Named Range = myCell
Set rng = Intersect(Target, Me.Range("myCell").Precedents)
On Error GoTo 0

If Not rng Is Nothing And Range("myCell").Value > 100 Then
Call MyMacro
End If

End Sub
'<<=============
'=============>>
Sub MyMacro()
Dim SH As Worksheet
Application.ScreenUpdating = False

Set SH = ThisWorkbook.Sheets("Sheet2") '<<==== CHANGE
With SH.OLEObjects("Object 1") '<<==== CHANGE

.Visible = False
.Verb
End With

Application.ScreenUpdating = True
End Sub
'<<============
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top