Als Antwort auf diesen Beitrag
Hallo Udo,
bevor ich dir das deinen Dingen passend weiter baue, teste diesen per API-Funktion aufgebauten und asynchron zu VBA arbeitenden Vorschlag:
Option Explicit
Declare PtrSafe Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" _
(ByVal lpszName As String, ByVal hModule As LongPtr, ByVal dwFlags As Long) As Long
Const SND_ASYNC As Long = &H1
Const SND_FILENAME As Long = &H20000
Const SND_NOSTOP As Long = &H10
Sub SprecheZweiTexte()
Dim wav1$, wav2$
wav1 = Environ$("TEMP") & "\tts1.wav" ' kann nach Bedarf erweitert werden
wav2 = Environ$("TEMP") & "\tts2.wav"
TextToWav "Ich spreche einen Text und dieser kann jederzeit abgebrochen werden ohne dass es zu irgenwelchen seltsamen Sachen kommen dürfte", wav1
TextToWav "ein weiterer gesprochender Text", wav2
' kann man sowohl mit Schleife als einzeln weiter bauen
PlayWavAndWait wav1
PlayWavAndWait wav2
End Sub
Sub StopSound() ' Das stoppt das jeweilige laufende Wave da asynchron direkt
PlaySound vbNullString, 0, 0
End Sub
Sub TextToWav(text As String, wavPath As String)
Dim spk As Object, fil As Object
Set spk = CreateObject("SAPI.SpVoice")
Set fil = CreateObject("SAPI.SpFileStream")
fil.Open wavPath, 3 ' SSFMCreateForWrite
Set spk.AudioOutputStream = fil
spk.Speak text
fil.Close
End Sub
Sub PlayWavAndWait(wavPath As String)
Dim i#: i = Timer
PlayWavAsync wavPath
Do While Timer < i + 0.1
DoEvents
Loop
Do While SoundIsPlaying()
DoEvents
Loop
End Sub
Sub PlayWavAsync(wavPath As String)
PlaySound wavPath, 0, SND_ASYNC Or SND_FILENAME
End Sub
Function SoundIsPlaying() As Boolean ' PlaySound mit SND_NOSTOP gibt 0 zurück, wenn gerade ein Sound läuft
SoundIsPlaying = (PlaySound(vbNullString, 0, SND_NOSTOP) = 0)
End Function
Was kann dieser Lösungsansatz (mehr ist es im Moment nicht):
- Die Wiedergabe arbeitet asynchron zu VBA
- Es kann jederzeit das aktuell laufende Wave abgebrochen werden (hat aber eine kleine treiberbedingte Latenz)
- Da eine Wave temporär erzeugt wird sollte die Wiedergabe störungsfrei sein
https://www.herber.de/bbs/user/180836.xlsm
Gruß Uwe