mciSendString
27.07.2021 16:01:21
Tim
ich versuche gerade diesen tollen Code zu fixen, um damit Worte aus Excel in Sprachdateien zu konvertieren.
Dabei wird jedes Wort der Spalte C laut vorgelesen und "soll" dann einzeln (jede Zelle!) als .wav-Datei an einem auszuwählenden Ort gespeichert werden.
Das funktioniert auch super, allerdings nur wenn ich die Zeilen im Code lösche, die
RetVal = mciSendString(commandstring, vbNullString, 0, 0&)
Kann mir jemand helfen, was es mit diesem "RetVal" auf sich hat? Muss ich eine Anwendung installieren, um "mciSendString" zu nutzen?
Vielen Dank und hier der gefundene Code:
Sub Schaltfläche1_Klicken()
Dim myrange As Range
Dim singlecell As Range
Dim wavename As Range
' Set reading range - Currently set for 498 lines (3 to 500)
If wave_type = 1 Then
Set myrange = Range("c3:c17")
Else
Set myrange = Range("c18:c500")
End If
Dim mywave As String
Dim MyFile As String
Dim commandstring As String
Dim RetVal As String * 255
Dim wavecount As Integer
Dim temp As String
Dim my_file_text As String
' Set default for file naming
wavecount = 1
For Each singlecell In myrange
singlecell.Select
' Fill it in with color so we know where we are.
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
' File Names don't like spaces, replace with a dash.
' singlecell.Value = Replace(singlecell.Value, " ", "-")
' Yack
If singlecell.Value "" Then
'Look one column to the left and get the file name
my_file_text = singlecell.Offset(0, -1).Value
' Swap any spaces with underscore to fix a file issue.
my_file_text = Replace(my_file_text, " ", "_")
commandstring = "Open new type waveaudio alias RecWavFile"
RetVal = mciSendString(commandstring, vbNullString, 0, 0&)
commandstring = "Record RecWavFile Insert"
RetVal = mciSendString(commandstring, vbNullString, 0, 0&)
' Adjust this to allow application to start recording.
Sleep (100)
Application.Speech.Speak (singlecell.Value)
DoEvents
' Adjust this setting to stop voice being cut off
Sleep (1000)
commandstring = "Stop RecWavFile Wait"
RetVal = mciSendString(commandstring, vbNullString, 0, 0&)
' Compile the file name here...
MyFile = "C:\YACK\" + my_file_text + ".wav"
commandstring = "Save RecWavFile " & MyFile
RetVal = mciSendString(commandstring, vbNullString, 0, 0&)
commandstring = "Close RecWavFile"
RetVal = mciSendString(commandstring, vbNullString, 0, 0&)
Else
' Do Nothing
End If
' Quiet time
wavecount = wavecount + 1
' Set the cell to no color
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Next singlecell
'Set the active cell back at the top.
Range("B3").Select
End Sub