AW: Das würde dann...
17.01.2025 11:11:47
Siegfried Pütz
Guten Morgen,
habe gestern alle Dateien aktualisiert. Bei den Probeeingaben, sowie beim letzten Training, nervt es, das beim checken (Beispiel: Doppel 2 soll ausgeworfen werden, wird aber nur eine einfache 2 getroffen, dann erfolgt nach Eintrag von "2" "das war nichts").
Jetzt ist mein Gedanke, das ab Runde 10, nur noch "no score" bzw. der jeweilige "Siegersound" ertönt.
Im Anhang der bisherige Code.
Also: Range "D4:D14", K4:K14" für alle Mains, "D15:D33 , K15:K33" ohne Case 4.
Danke für Eure Hilfe.
Grüße Euch,
SiggiP
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Sh.Name Like "Rd*" And Target.CountLarge = 1 Then
If Intersect(Target, Range("D4:D33", "K4:K33")) Is Nothing Or Trim(Target.Value) = "" Then Exit Sub
Else
Exit Sub
End If
If Cells(4, Target.Column + 1).Value = 0 Then
Call Main(2, Cells(1, Target.Column).Value)
ElseIf fncSchnapszahl(Cells(4, Target.Column + 1)) = True Then
Call Main(3, "Schnapszahl")
Else
Select Case Target.Value
Case 100
Call Main(6)
Case 0
Call Main(5)
Case 120, 140, 160, 170, 180
Call Main(Target.Value, Target.Value)
Case Is = 10
Call Main(4)
Case Is >= 80
Call Main(1)
End Select
End If
End Sub
Option Explicit
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)
Select Case lngTMP
Case 1
Call objSpeech.Speak("schöne Darts")
Application.Wait Now + TimeValue("00:00:01")
Call objSpeech.Speak("super")
Case 2, 3, 120, 140, 160, 170, 180
sndPlaySound 0, SND_ASYNC
sndPlaySound ThisWorkbook.Path & Application.PathSeparator & strName & ".wav", SND_ASYNC Or SND_NODEFAULT
Case 4
Call objSpeech.Speak("dat war überhaupt nix")
Case 5
Call objSpeech.Speak("no score")
Case 6
Call objSpeech.Speak("einhundert")
Application.Wait Now + TimeValue("00:00:01")
Call objSpeech.Speak("weiter so")
End Select
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
