Pause einfügen wenn....
10.07.2025 22:56:54
Siegfried Pütz
KI bekommt folgendes Problem nicht gelöst. Hoffe das jemand eine Lösung hat. Im Anhang habe ich einen funktionierenden Code.
Was ich nun möchte in der Logik: Ist nur ein Beispiel, sollte aber auf alle relevanten Zellen zutreffen: In der Zelle D1 füge ich einen Wert ein. Daraufhin wird Text to speech für Zelle K1 angesteuert. Das funktioniert. Ich möchte aber vermeiden, das nach jedem Eintrag die entsprechende Text to speech Funktion angesprochen wird. Meine Idee: Wenn, siehe Beispiel, in Zelle D4 ein Eintrag erfolgt, eine Pause von 7 Sekunden erfolgen. Wenn innerhalb der 7 Sekunden ein Eintrag in einer der Zellen K, soll text to speech nicht ausgeführt werden. Die entsprechenden Mainanweisungen sollen nicht geändert werden. Ich hoffe es ist Verständlich. Wenn noch etwas unklar, Bitte melden.
Grüße Euch
SiggiP
jetzt der Code:
#If VBA7 Then
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If
Private Sub Workbook_SheetChange(ByVal SH As Object, ByVal Target As Range)
On Error GoTo Ende
Dim speech As Object
Dim ausgabeText As String
Dim doSpeech As Boolean: doSpeech = False
Dim spaltenTitel As String
Dim schnapsZahlZelle As Range
Dim col As Long
Dim zeile As Long
Dim wertInZeile4 As Variant
If Target.Cells.Count = 1 Then
col = Target.Column
zeile = Target.Row
' === 1. Text je nach Spalte & gerader/ungerader Zeile ===
If Not IsEmpty(Target.Value) And zeile >= 4 And zeile = 33 Then
Select Case col
Case 4 ' Spalte D
If SH.Range("E4").Value > 0 Then
If zeile Mod 2 = 0 Then
ausgabeText = SH.Range("k1").Text
Else
ausgabeText = SH.Range("l1").Text
End If
doSpeech = True
End If
Case 11 ' Spalte K
If SH.Range("L4").Value > 0 Then
If zeile Mod 2 = 0 Then
ausgabeText = SH.Range("r1").Text
Else
ausgabeText = SH.Range("s1").Text
End If
doSpeech = True
End If
Case 18 ' Spalte R
If SH.Range("S4").Value > 0 Then
If zeile Mod 2 = 0 Then
ausgabeText = SH.Range("e1").Text
Else
ausgabeText = SH.Range("d1").Text
End If
doSpeech = True
End If
End Select
End If
' === 2. Logik für Rd*-Blätter ===
If SH.Name Like "Rd*" Then
If Not Intersect(Target, SH.Range("D4:D33,K4:K33,R4:R33,Y3:Y33")) Is Nothing Then
If Trim(Target.Value) > "" Then
col = Target.Column
spaltenTitel = SH.Cells(1, col).Value
wertInZeile4 = SH.Cells(4, col + 1).Value
' Schnapszahl prüfen
Select Case col
Case 4: Set schnapsZahlZelle = SH.Range("E4")
Case 11: Set schnapsZahlZelle = SH.Range("L4")
Case 18: Set schnapsZahlZelle = SH.Range("S4")
End Select
If Not schnapsZahlZelle Is Nothing Then
Select Case schnapsZahlZelle.Value
Case 111, 222, 333, 444
Call Main(3, "Schnapszahl")
Sleep 15000 ' Warte bis Sound abspielt
End Select
End If
' Weitere Main-Aufrufe
If wertInZeile4 = 0 Then
Call Main(2, spaltenTitel)
Else
Select Case Target.Value
Case 120, 140, 160, 170, 180, 100, 171, 26, 0, 41
Call Main(Target.Value, Target.Value)
Case Is > 100
Call Main(1)
End Select
End If
End If
End If
End If
' === 3. Sprache ausgeben (nach Main-Aufrufen) ===
If doSpeech Then
Sleep 1000 ' ? Pause von 2 Sekunden nach Main
Set speech = CreateObject("SAPI.SpVoice")
speech.Speak ausgabeText
Sleep 1
speech.Speak "Du bist dran."
End If
End If
Ende:
Set speech = Nothing
End Sub
Private Sub Workbook_SheetActivate(ByVal SH As Object)
SH.Range("D4").Select
End Sub
Anzeige
