Afspille lyd ved ændring af celles indholdt

Om det er smart, ved jeg ikke. Fandt det lige på nettet:
Det hele er lagt i Ark1's kode.


Option Explicit

' ===== API declarations =====

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

Private Declare Function PlaySound Lib "winmm.dll" _
            Alias "PlaySoundA" _
                (ByVal lpszName As String, _
                ByVal hModule As Long, _
                ByVal dwFlags As Long) As Long

' Sound Flag
Private Const SOUND_FILENAME = &H20000

' ===== Method 1 =====

Public Function PlaySoundFileA(sndFileName As String) As Boolean

Dim iSuccess As Integer
iSuccess = sndPlaySound(sndFileName, SOUND_FILENAME)
If iSuccess = 0 Then
    PlaySoundFileA = False
Else
    PlaySoundFileA = True
End If

End Function

Private Sub Worksheet_Change(ByVal Target As Range)
    If Cells(1, 1).Value = "0" Then
        PlaySoundFileA ("D:\temp\mywav.wav")
    End If

End Sub

Link: http://skp.mvps.org/ppt00040.htm#3

Den har jeg svært ved at bruge. For det første relaterer det du har fundet sig til PowerPoint og ikke Excel. For det andet aner jeg ikke hvad jeg skal gøre med sådan en stump kode ;o) Men tak for buddet.

Andre bud?

Ok, jeg må se hvad der er galt med mit Excel program. Dér fungerer det udmærket.

Brynils kode virker udemærket i excel.
den skal bare lige deles lidt

Dette skal i et alm. vba/makromodul
Tryk alt-f11, under Insert opret module

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

Private Declare Function PlaySound Lib "winmm.dll" _
            Alias "PlaySoundA" _
                (ByVal lpszName As String, _
                ByVal hModule As Long, _
                ByVal dwFlags As Long) As Long

Private Const SOUND_FILENAME = &H20000

Public Function PlaySoundFileA(sndFileName As String) As Boolean
Dim iSuccess As Integer
iSuccess = sndPlaySound(sndFileName, SOUND_FILENAME)
If iSuccess = 0 Then
    PlaySoundFileA = False
Else
    PlaySoundFileA = True
End If
End Function


denne del her skal indsættes i kodemodulet der hører til det ark hvor checkcellen befinder sig (højreklik på arkfanen og vælg "vis programkode" og indsæt dette:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("A1").Value = 0 Then
        PlaySoundFileA ("C:\Programmer\MSN Messenger\type.wav")
    End If
End Sub


Når så A1 bliver 0 afspilles en lyd.

>> Hej bak. Jeg troede faktisk også at den opdeling du beskriver var nødvendig, men jeg erfarede at det kørte som forventet med al koden i Ark1. (Kopierede bare det hele ind fra linket for lige at se hvad der skete)
Er der nogle bagdele ved at have koden dér, eller ér min Excel bare underlig? ;-)

Noget galt er der dog. Den giver lyd uanset hvilken celle der går i 0.

Noget omstændeligt, men det sku virke og give lyd når celle A1 ændres til 0.

Kode i Ark1:

Option Explicit
Dim iSuccess As Integer
' ===== API declarations =====

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

Private Declare Function PlaySound Lib "winmm.dll" _
            Alias "PlaySoundA" _
                (ByVal lpszName As String, _
                ByVal hModule As Long, _
                ByVal dwFlags As Long) As Long

' Sound Flag
Private Const SOUND_FILENAME = &H20000

' ===== Method 1 =====

Public Function PlaySoundFileA(sndFileName As String) As Boolean

    If iSuccess = 0 Then
        PlaySoundFileA = False
    Else
        PlaySoundFileA = True
        iSuccess = sndPlaySound(sndFileName, SOUND_FILENAME)
    End If

End Function

Private Sub Worksheet_Activate()

    If ActiveSheet.Name = "Ark1" Then
        If Range("A1").Value = "0" Then
            ThisWorkbook.HaveRun = True
        Else
            ThisWorkbook.HaveRun = False
        End If
    End If

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    If ThisWorkbook.HaveRun = False Then
        If Range("A1").Value = "0" Then
            iSuccess = 1
            PlaySoundFileA ("D:\temp\mywav.wav")
            iSuccess = 0
            ThisWorkbook.HaveRun = True
        End If
    End If
   
    If Range("A1").Value <> "0" Then
        ThisWorkbook.HaveRun = False
        iSuccess = 0
    End If

End Sub

Kode i ThisWorkbook:

Option Explicit
Public HaveRun As Boolean

Jeg kan ikke helt finde ud af hvor de enkelte ting skal sættes ind. Kan jeg få en walkthrough? Jeg sætter pointene op, da denne opgave er sværere end først antaegt.

Noget af det kan jeg forklare. Ellers må du have en anden ind over.

Jeg har taget udgangspunkt i at cellen du kontrollerer er A1 og at den er placeret i Ark1. Det skal selvfølgelig ændres nogle steder så det passer med dine egne.

Højreklik på fanebladet, hvor cellen du vil kontrollere på, befinder sig. Nederste punkt i menuen der kommer frem hedder på dansk: 'Vis programkode'. Når du vælger det, kommer du automatisk til arkets kodemodul.

Smid al koden mellem >>>> og <<<< ind i toppen af kodemodulet:

>>>>

Option Explicit ' MÅ KUN FOREKOMME 1 GANG I MODULET
Dim iSuccess As Integer

' ===== API declarations =====

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

Private Declare Function PlaySound Lib "winmm.dll" _
            Alias "PlaySoundA" _
                (ByVal lpszName As String, _
                ByVal hModule As Long, _
                ByVal dwFlags As Long) As Long

' Sound Flag
Private Const SOUND_FILENAME = &H20000

' ===== Method 1 =====

Public Function PlaySoundFileA(sndFileName As String) As Boolean

    If iSuccess = False Then
        PlaySoundFileA = False
    Else
        PlaySoundFileA = True
        iSuccess = sndPlaySound(sndFileName, SOUND_FILENAME)
    End If

End Function

' ------------------------------------------------
' Check om celle A1 allerede er 0. Hvis den er, så
' sæt variablen HaveRun til True. Ellers til False.

Private Sub Worksheet_Activate()

    If ActiveSheet.Name = "Ark1" Then        ' SKIFT ARKNAVN
        If Range("A1").Value = "0" Then      ' SKIFT CELLEADRESSE
            ThisWorkbook.HaveRun = True
        Else
            ThisWorkbook.HaveRun = False
        End If
    End If

End Sub


' ------------------------------------------------
' Hver gang der sker en ændring af værdier i dit ark,
' køres denne makro.
Private Sub Worksheet_Change(ByVal Target As Range)

    ' Hvis celle A1 ikke var 0 da arket blev aktiveret,
    '(dvs. HaveRun = False)...
    If ThisWorkbook.HaveRun = False Then

        ' ...så undersøg om denne makro bliver kørt fordi
        ' celle A1 har fået værdien 0 tildelt.
        If Range("A1").Value = "0" Then        ' SKIFT CELLEADRESSE

            ' Sæt iSuccess til True, som bruges i
            ' funktionen PlaySoundFileA og kald derefter
            ' denne funktion for at få afspillet en lyd.
            iSuccess = True
            PlaySoundFileA ("D:\temp\mywav.wav")

            ' For at undgå at der afspilles lyd ved enhver
            ' efterfølgende ændring i arket, sættes iSuccess
            ' til False og HaveRun til True
            iSuccess = False  ' måske overflødig
            ThisWorkbook.HaveRun = True
        End If
    End If
   

    ' Hvis celle A1 herefter ikke er 0 (fx. ændret fra 0 til 1),
    ' så sæt variablerne til False, så koden herover ikke bliver
    ' ignoreret.
    If Range("A1").Value <> "0" Then          ' SKIFT CELLEADRESSE
        ThisWorkbook.HaveRun = False
        iSuccess = False
    End If

End Sub

<<<<


Dobbeltklik på ThisWorkbook i projektvinduet til venstre og indsæt denne 'globale' variabel:

Public HaveRun As Boolean


Jeg skal ærligt indrømme at jeg ikke tror dette er den mest hensigtsmæssige måde at gøre det på, men mon ikke der er andre med interesse for points der vil kommentere det. ;)

Den kan også løses lidt anderledes.
Jeg har bygget en regnearksfunktion, som kan indsættes i en tilfældig celle.
når den celle, funktionen refererer til fx A1 , bliver nul, sørger funktionen for at der afspilles en lyd.

Tag hele nedenstående kode og læg ind i et makromodul.
Du kan så indsætte funktionen stest et sted i dit ark.
=STEST(A1)
Der vil afspilles en lyd hvis A1 bliver 0
Du skal selv ændre stien til din lydfil.
Private Declare Function sndPlaySound Lib "winmm.dll" _
      Alias "sndPlaySoundA" _
      (ByVal lpszSoundName As String, _
      ByVal uFlags As Long) As Long

Private Declare Function PlaySound Lib "winmm.dll" _
      Alias "PlaySoundA" _
      (ByVal lpszName As String, _
      ByVal hModule As Long, _
      ByVal dwFlags As Long) As Long

Private Const SOUND_FILENAME = &H20000

Public Function PlaySoundFileA(sndFileName As String) As Boolean
Dim iSuccess As Integer
iSuccess = sndPlaySound(sndFileName, SOUND_FILENAME)
If iSuccess = 0 Then
    PlaySoundFileA = False
Else
    PlaySoundFileA = True
End If
End Function

Function stest(cell)
If cell = 0 Then
PlaySoundFileA ("C:\Programmer\MSN Messenger\type.wav")
End If
stest = ""
End Function

Meget enklere at anvende. Og hvis man retter lidt:

If cell = "0" Then

undgår man lyd når cellen bliver tom, hvis det er en mulighed der skal tages højde for.

Bak>> Den løsning virker fint. Dog giver den et nyt problem. Du kom med et genialt svar i http://www.eksperten.dk/spm/614740#rid5537603 ang. refresh af data. Problemet er nu at lyden bliver spillet hver gang data refreshes af den metode du gav mig i det andet spørgsmål. Hvordan undgår jeg dette?

P.S.: Brynil>> Som tak for dit store forsøg skal jeg nok også give nogle point til dig ;o)

Det burde den ikke gøre medmindre cellen bliver nul ved opdatering.
Gør den det ?

Nej, den er nul allerede, så den ændrer sig ikke.

Det er der den går galt.
En funktion opdaterer hver hver genberegning og vil jo derfor afspille lyd når den bliver genberegnet og værdien igen er nul.

Hvad kan jeg så gøre?

Nå, det lader ikke til at vi kommer videre med denne. Den var også lidt tricky. Brynil og Bak, vil I smide et svar, så I kan få lidt point som tak for forsøget?

I må meget gerne smide svar, så jeg kan lukke igen ;o)

ok:-)

Nå, det lader ikke til at der kommer yderligere svar, så du får pointene med tak for forsøget, selvom det ikke lykkedes.

Hygge og god jul

FCS