wav sound einfügen
12.01.2025 22:14:50
Siegfried Pütz
in meiner Excel Datei habe ich schon diverse Sound Zuweisungen durch Eure Hilfe durchgeführt. Jetzt möchte ich noch einige hinzufügen.
Bin schon den ganzen Nachmittag am "Rumtricksen", ohne Erfolg. Kurze Erklärung: hierbei handelt es sich um Eintragungen in einer "Dartliste".
Hier möchte ich jetzt z.B.: wenn ein Darter 120 wirft soll dann eine wav Datei (120.wav) abgespielt werden. Dann noch bei 140,160,170,180.
In der Beispieldatei sind schon für Namen Sounds zugewiesen, genau so für "Schnapszahlen", also 111,222, usw.
Die funktionieren alle. Die Codes für die "Wav Dateien" soll den Zellen "D4:D33 und K4:K33 zugeordnet werden!
Aber wie schon beschrieben; mit den anderen Zuweisungen habe ich Probleme :-(
Stelle mal 2 Codes rein, einmal "diese Arbeitsmappe" und "Main".
Wenn jemand helfen kann?
Gruß
SiggiP
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name Like "Rd*" Then
If Target.CountLarge = 1 Then
If Not Intersect(Target, Range("D4:D33")) Is Nothing And Trim(Target.Value) > "" Then
If Range("E4").Value = 0 Then
Call Main(2, Range("D1").Value)
ElseIf fncSchnapszahl(Range("E4")) = True Then
Call Main(3, "Schnapszahl")
Else
If Target.Value = 100 Then Call Main(6)
If Target.Value = 0 Then Call Main(5)
If (Target.Value >= 1 And Target.Value = 10) Then Call Main(4)
If (Target.Value >= 80 And Target.Value 99) Then Call Main(1)
End If
ElseIf Not Intersect(Target, Range("K4:K33")) Is Nothing And Trim(Target.Value) > "" Then
If Range("L4").Value = 0 Then
Call Main(2, Range("K1").Value)
ElseIf fncSchnapszahl(Range("L4")) = True Then
Call Main(3, "Schnapszahl")
Else
If Target.Value = 100 Then Call Main(6)
If Target.Value = 0 Then Call Main(5)
If (Target.Value >= 1 And Target.Value = 10) Then Call Main(4)
If (Target.Value >= 80 And Target.Value 99) Then Call Main(1)
End If
End If
End If
End If
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Sh.Range("D4").Select
End Sub
Private Declare PtrSafe Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Private Const SND_ASYNC = &H1
Private Const SND_NODEFAULT = &H2
Public Sub Main(ByVal lngTMP As Long, Optional ByVal strName As String)
Dim objSpeech As Object
Set objSpeech = CreateObject(Class:="SAPI.SpVoice.1")
Set objSpeech.Voice = objSpeech.GetVoices.Item(0)
If lngTMP = 1 Then
Call objSpeech.Speak("schöne Darts")
Application.Wait Now + TimeValue("00:00:01")
Call objSpeech.Speak("super")
ElseIf lngTMP = 2 Then
sndPlaySound 0, SND_ASYNC
sndPlaySound ThisWorkbook.Path & Application.PathSeparator & strName & ".wav", SND_ASYNC Or SND_NODEFAULT
ElseIf lngTMP = 3 Then
sndPlaySound 0, SND_ASYNC
sndPlaySound ThisWorkbook.Path & Application.PathSeparator & strName & ".wav", SND_ASYNC Or SND_NODEFAULT
'Call objSpeech.Speak("Pause")
'Application.Wait Now + TimeValue("00:00:01")
'Call objSpeech.Speak("einen Schnaps für alle")
ElseIf lngTMP = 4 Then
Call objSpeech.Speak("dat war überhaupt nix")
ElseIf lngTMP = 5 Then
Call objSpeech.Speak("no score")
ElseIf lngTMP = 6 Then
Call objSpeech.Speak("einhundert")
Application.Wait Now + TimeValue("00:00:01")
Call objSpeech.Speak("weiter so")
End If
Set objSpeech = Nothing
End Sub
Function fncSchnapszahl(ByVal rngCell As Range) As Boolean
Dim objRegEx As Object
Set objRegEx = CreateObject("VBScript.RegExp")
'objRegEx.Pattern = "^(.)\1+$"
objRegEx.Pattern = "^(.)\1{2}$"
fncSchnapszahl = objRegEx.Test(rngCell.Value)
End Function
Anzeige
