sesli okutma

[orcunerkek54]

arkadaşlar forumdan adını hatırlayamadığım bir arkadaşımızın yapmış olduğu sesli sayı okuma çalışması elimde var.buna sayıların okumasını bitirdikten sonra ses dosyasını eklediğim "numaralı kaydınız kaydedilmiştir" adlı dosyamıda söylemesini istiyorum ancak bunu kendim başaramadım yardımlarınızı bekliyorum.fazla olan kısımlarıda çıkartırmısınız.teşekkürler

 

[dEdE]

Mrb.,
Mevcut kodu aşaığdaki şekilde değiştirdim. Sanırım sizin istediğiniz buydu.

Function seslioku(sy)
On Error Resume Next
sesx$ = ThisWorkbook.Path & "\" & "numaralı cihazın kaydı yapılmıştır.wav" '--Eklenen kod----
dz1 = Array(" ", "bir", "iki", "üç", "dört", "beş", "altı", "yedi", "sekiz", "dokuz")
dz2 = Array(" ", "on", "yirmi", "otuz", "kırk", "elli", "altmış", "yetmiş", "seksen", "doksan")
dz3 = Array(" ", "", "bin", "milyon", "milyar", "trilyon", "katrilyon")
tur = Len(sy) \ 3
kalan = Len(sy) Mod 3
k = 2
sayı = ""
For i = 1 To tur
sya = Mid(sy, (Len(sy) - k), 3)
sy1 = dz1(Mid(sya, 3, 1)): sy2 = dz2(Mid(sya, 2, 1)): sy3 = dz1(Mid(sya, 1, 1))
Select Case Mid(sya, 1, 1)
Case 1
sy3 = "yüz"
Case Is > 1
sy3 = sy3 & " " & "yüz"
End Select
If i = 2 Then
Select Case Val(sya)
Case 0
sy1 = ""
Case 1
sy1 = "bin"
Case Is > 1
sy1 = sy1 & " " & "bin"
End Select
Else
birim = dz3(i)
End If
If Val(sya) > 0 Then
sayı = sy3 & " " & Trim(sy2) & " " & sy1 & " " & birim & " " & Trim(sayı)
k = k + 3
Else
k = k + 3
End If
Next i
If kalan = 0 Then
f = sayı
p = InStr(1, LTrim(f), " ")
Do While p > 0
s = Trim(Mid(f, 1, p))
f = LTrim(Mid(f, p, Len(f)))
p = InStr(1, f, " ")
ses$ = ThisWorkbook.Path & "\" & s & ".wav"
Call PlaySound(ses$, 1, 0)
Loop
If f <> "" Then
s = f
ses$ = ThisWorkbook.Path & "\" & s & ".wav"
Call PlaySound(ses$, 1, 0)
End If
Call PlaySound(sesx$, 1, 0) '-------Eklenen kod------
Exit Function
Else
End If
syb = Mid(sy, 1, kalan)
sy11 = dz1(Mid(syb, kalan, 1)): sy22 = dz2(Mid(sy, kalan - 1, 1))
If tur = 1 Then
Select Case Val(Mid(syb, 1, 2))
Case 0
sy11 = ""
Case 1
sy11 = "bin"
Case Is > 1
sy11 = sy11 & " " & "bin"
End Select
Else
birim1 = dz3(tur + 1)
End If
sayı = sy22 & " " & sy11 & " " & birim1 & " " & sayı
f = LTrim(sayı)
p = InStr(1, f, " ")
Do While p > 0
s = Trim(Mid(f, 1, p))
f = LTrim(Mid(f, p, Len(f)))
p = InStr(1, f, " ")
ses$ = ThisWorkbook.Path & "\" & s & ".wav"
Call PlaySound(ses$, 1, 0)
Loop
If f <> "" Then
s = f
ses$ = ThisWorkbook.Path & "\" & s & ".wav"
Call PlaySound(ses$, 1, 0)
End If
Call PlaySound(sesx$, 1, 0) '-------Eklenen kod------
End Function

Saygılar.

 

[orcunerkek54]

syn dEdE ilgini için teşekkürler. söylemiş olduğunuz eklentileri yaptım ancak sayıyı okuyor fakat cihaz kaydı yappılmıştırı çalmıyor.acaba hatam nerede olabilir..

 

[dEdE]

Mrb.,
Kodu tekrar değiştirdim. Akşam aceleyle hata yapmışım. Yukarıdaki kodu aynen kullanırsanız sorununuz çözülecektir. Eğer hala çalışmıyorsa "numaralı cih..." isimli sese dosyasının adında veye dosya yolunda bir sorun var demektir.
Gerçi tüm olasılıkları denemedim ama yaptığım denemelerde hata vermeden çalıştı.
Saygılar.

 

[orcunerkek54]

syn dEdEyardımınız ve emeğiniz için çok teşekkür ederim.çpk güzel olmuş :mutlu: .sizden mümkünse birşey daha istiye bilirmiyim eğer mümkünse bu kodların çalışma mantığını açıklayabilirmisiniz. başka denemelerimde bana veri tabanı olması maksatlı olarak açıklama veya küçük bir örnek eklermisiniz.bu kodlardan anladım desem pek yalan olmaz.....