Ard arda wav dosyası oynatma

Katılım
12 Nisan 2007
Mesajlar
170
Excel Vers. ve Dili
Office XP
Arkadaşlar

9 haneye kadar sayıları okuyan bir makro yazdım. 1'den 9'a, 10'dan 90'a ve Yüz, Bin, Milyon ve Milyar kelimelerini ses kaydı ile kaydettim. Örneğin 995 sayısını okutmak için aşağıdaki dosyaları WindowsMediaPlayer nesnesi ile ve sıra ile çaldırıyorum.
9.Wav
Yüz.Wav
90.Wav
5.Wav

Fakat sonuçta sadece "Beş" diye bir ses duyuyorum. Yani ilk 3 dosyanın sesi duyulmuyor. Kodlar ilk video bitmeden ikinciyi, o da bitmeden üçüncüyü çalmaya başlıyor. Sonuç olarak sadece son dosya düzgün çalıyor. Bu durumu çözmek için
"Application.OnTime Now + TimeValue("00:00:02"), "YüzOku" "
şeklinde 2 sn. bekletme koydum. Sorun kısmen çözüldü. Rakamlar arasında biraz fazla bekliyor. Süreyi 1 sn. yapınca da iki rakam birbirine karışıyor. Ama benim yapmak istediğim ilk dosya bitince ikinci dosyanın çalması. Bunu Timer nesnesiyle yapabilir miyim. Yoksa başka bir çözüm yolu var mıdır. Yardımlarınız için şimdiden teşekkür ediyorum.
 

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Merhaba, mutlaka en doğru yöntem için cevap alacaksınızdır.

Dolambaçlı bir yöntem olarak şöyle düşünülebilir;
her bir ses dosyası için excel sayfasında bir hücreye bir veri yazdırılıp;
If Then End If Loop şeklinde bir yapı kurulur.
İlk ses dosyası çaldıktan sonra hücreye birşey yazar,
ikinci ses dosyasının çalmaya başlama kriteri de birinciden sonra yazılan verinin kontrolü koyulabilir,
benzer durum ikinciden üçüncüye, üçüncüden dördüncüye gibi oluşturulabilir sanırım.
En sonunda da hücrelere yazdırılan veriler temizlenir (bir soraki işlem için elbette).

Kod olsaydı belki başka fikir de olabilirdi bilemiyorum.
.
 
Son düzenleme:
Katılım
12 Nisan 2007
Mesajlar
170
Excel Vers. ve Dili
Office XP
Ömer Bey cevabınız için öncelikle teşekkürler. Bu dediğiniz öneriyi aynen uygulamıştım. Fakat bu yöntemde de excele yazdırdığımız yazı kodları tetiklediğinde ses dosyasının bitip bitmediğine bakmıyor malesef. Dolayısıyla ilk rakam okunmadan ikinci rakamı okumaya başlıyor.
 

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
İlk hücreye veriyi ilk ses çalma sonrasında yazdırın, ikincinin çalmasını birincinin yazdığı veri var mı diye kotrol ettirince olması lazım sanki, böylece devam eder bence.

Yani veri, ses çalındıktan sonra yazılır, sonraki ses dosyası bir önceki sesten sonra yazılan veri var mı diye bakar, varsa çalışır ve ikinci veriyi yazar...
Olayın tümü de Loop döngüsüne alınabilir veya yine If koşuluyla önceki kod satırlarına yönlendirilebilir.

Hatta süre için Timer çalıştırıp (ses dosyalarının sürelerine göre deneme yanılma ile bulacağınız değere kadar) timer sonucu hücreye yazrılabilir.
Vs. vs.
Neticede kod görülseydi yeni fikirler çıkabilir bence.
 
Son düzenleme:

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Tekrar merhaba.

-- Sayfanın kod bölümüne aşağıdaki kod'u ekledim.
Kod:
[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
If Intersect(Target, [[B][COLOR="red"]A1[/COLOR][/B]]) Is Nothing Then Exit Sub
Call [B]brn[/B]
[B]End Sub[/B]
-- Bir Modül'e de aşağıdaki kod'u ekledim.
Kod:
Declare Function sndPlaySound32 Lib "winmm.dll" Alias "sndPlaySoundA" _
    (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

[B]Sub brn()[/B]
    Call sndPlaySound32("[COLOR="Blue"]C:\Users\admin\Downloads\ses\[/COLOR][COLOR="red"]6_claps.wav[/COLOR]", 0)
    Call sndPlaySound32("[COLOR="blue"]C:\Users\admin\Downloads\ses\[/COLOR][COLOR="Red"]start.wav[/COLOR]", 0)
[B]End Sub[/B]
Sayfadaki A1 hücresi değiştiğinde iki ses dosyası kesintisiz peşpeşe çalıştı.
Aynı kod'u sayfaya eklediğim bir düğme üzerinden de sorunsuz çalıştırdım.

Kullandığınız kodları bilemiyorum, belki farklıdır ve yukarıdaki şekilde istediğniz sonuca ulaşırsınız.
.
 
Katılım
12 Nisan 2007
Mesajlar
170
Excel Vers. ve Dili
Office XP
Ömer Bey

Size çok ama çooooooook teşekkür ediyorum. Ses dosyası m4a uzantılı olduğu için media player nesnesi ile deniyordum. Ama sonuç alamamıştım. Önerdiğiniz yöntem işe yaradı. Tekrar teşekkür ederim.
 

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Ömer Bey

Size çok ama çooooooook teşekkür ediyorum. Ses dosyası m4a uzantılı olduğu için media player nesnesi ile deniyordum. Ama sonuç alamamıştım. Önerdiğiniz yöntem işe yaradı. Tekrar teşekkür ederim.
Estağfuruıah, ihtiyaç görüldüyse mesele yok.
Keşke ses dosyaları değilse de kodları paylaşmiş olsaydınız. Böylece ben dahil birçok üyenin işine yarardı.
Sağlıcakla.
.
 
Katılım
12 Nisan 2007
Mesajlar
170
Excel Vers. ve Dili
Office XP
Dosya Paylaşmayı bulamadım. Kodları paylaşayım.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Value = "" Then GoTo Bitiş
Application.EnableEvents = False
Range("A1").Value = Target.Value
Application.EnableEvents = True

Call SayıOku

Bitiş:

End Sub

Sub SayıOku()
uzunluk = Len(Range("A1").Value)
If uzunluk = 1 Then
Call BirlerOku
Else
If uzunluk = 2 Then
Call OnlarOku
Call BirlerOku
Else
If uzunluk = 3 Then
Call YüzlerOku
Call YüzOku1
Call OnlarOku
Call BirlerOku
Else
If uzunluk = 4 Then
Call BinlerOku
Call BinOku
Call YüzlerOku
Call YüzOku1
Call OnlarOku
Call BirlerOku
Else
If uzunluk = 5 Then
Call OnBinlerOku
Call BinlerOku
Call BinOku
Call YüzlerOku
Call YüzOku1
Call OnlarOku
Call BirlerOku
Else
If uzunluk = 6 Then
Call YüzbinlerOku
Call YüzOku2
Call OnBinlerOku
Call BinlerOku
Call BinOku
Call YüzlerOku
Call YüzOku1
Call OnlarOku
Call BirlerOku
Else
If uzunluk = 7 Then
Call MilyonlarOku
Call MilyonOku
Call YüzbinlerOku
Call YüzOku2
Call OnBinlerOku
Call BinlerOku
Call BinOku
Call YüzlerOku
Call YüzOku1
Call OnlarOku
Call BirlerOku
Else
If uzunluk = 8 Then
Call OnMilyonlarOku
Call MilyonlarOku
Call MilyonOku
Call YüzbinlerOku
Call YüzOku2
Call OnBinlerOku
Call BinlerOku
Call BinOku
Call YüzlerOku
Call YüzOku1
Call OnlarOku
Call BirlerOku
Else
If uzunluk = 9 Then
Call YüzMilyonlarOku
Call YüzOku3
Call OnMilyonlarOku
Call MilyonlarOku
Call MilyonOku
Call YüzbinlerOku
Call YüzOku2
Call OnBinlerOku
Call BinlerOku
Call BinOku
Call YüzlerOku
Call YüzOku1
Call OnlarOku
Call BirlerOku
End If
End If
End If
End If
End If
End If
End If
End If
End If
Bitiş:

End Sub

Sub BirlerOku()
uzunluk = Len(Range("A1").Value)

If uzunluk > 1 And Right(Range("A1").Value, 1) = 0 Then GoTo Bitiş
Call sndPlaySound32("E:\11-Sayı Okuma\1-Sesler\" & Right(Range("A1").Value, 1) & ".wav", 0)
Bitiş:

End Sub

Sub OnlarOku()
uzunluk = Len(Range("A1").Value)
If uzunluk >= 2 Then
onlarbasamağı = Right(Left(Range("A1").Value, uzunluk - 1), 1)
End If

If onlarbasamağı = 0 Or uzunluk < 2 Then GoTo Bitiş
Call sndPlaySound32("E:\11-Sayı Okuma\1-Sesler\" & onlarbasamağı & "0" & ".wav", 0)
Bitiş:

End Sub

Sub YüzlerOku()
uzunluk = Len(Range("A1").Value)
If uzunluk >= 3 Then
yüzlerbasamağı = Right(Left(Range("A1").Value, uzunluk - 2), 1)
End If

If yüzlerbasamağı = 0 Or yüzlerbasamağı = 1 Or uzunluk < 3 Then GoTo Bitiş
Call sndPlaySound32("E:\11-Sayı Okuma\1-Sesler\" & yüzlerbasamağı & ".wav", 0)
Bitiş:

End Sub

Sub YüzOku1()
uzunluk = Len(Range("A1").Value)
yüzlerbasamağı = Right(Left(Range("A1").Value, uzunluk - 2), 1)

If (yüzlerbasamağı = 0 And uzunluk >= 3) Or uzunluk < 3 Then GoTo Bitiş
Call sndPlaySound32("E:\11-Sayı Okuma\1-Sesler\Yüz.wav", 0)
Bitiş:

End Sub

Sub YüzOku2()
uzunluk = Len(Range("A1").Value)
yüzbinlerbasamağı = Right(Left(Range("A1").Value, uzunluk - 5), 1)

If (yüzbinlerbasamağı = 0 And uzunluk >= 7) Or uzunluk < 6 Then GoTo Bitiş
Call sndPlaySound32("E:\11-Sayı Okuma\1-Sesler\Yüz.wav", 0)
Bitiş:

End Sub

Sub YüzOku3()
uzunluk = Len(Range("A1").Value)
yüzmilyonlarbasamağı = Right(Left(Range("A1").Value, uzunluk - 8), 1)

If (yüzmilyonlarbasamağı = 0 And uzunluk >= 10) Or uzunluk < 9 Then GoTo Bitiş
Call sndPlaySound32("E:\11-Sayı Okuma\1-Sesler\Yüz.wav", 0)
Bitiş:

End Sub

Sub BinlerOku()
uzunluk = Len(Range("A1").Value)

If uzunluk >= 4 Then
binlerbasamağı = Right(Left(Range("A1").Value, uzunluk - 3), 1)
End If
onbinlerbasamağı = Right(Left(Range("A1").Value, uzunluk - 4), 1)
If uzunluk > 4 Then
yüzbinlerbasamağı = Right(Left(Range("A1").Value, uzunluk - 5), 1)
End If

If (binlerbasamağı = 0 Or uzunluk < 4) Or (uzunluk = 4 And binlerbasamağı = 1) Or _
(binlerbasamağı = 1 And onbinlerbasamağı = 0 And yüzbinlerbasamağı = 0) Then GoTo Bitiş
Call sndPlaySound32("E:\11-Sayı Okuma\1-Sesler\" & binlerbasamağı & ".wav", 0)
Bitiş:

End Sub

Sub BinOku()
uzunluk = Len(Range("A1").Value)
binlerbasamağı = Right(Left(Range("A1").Value, uzunluk - 3), 1)
onbinlerbasamağı = Right(Left(Range("A1").Value, uzunluk - 4), 1)
If uzunluk > 4 Then
yüzbinlerbasamağı = Right(Left(Range("A1").Value, uzunluk - 5), 1)
End If

If (binlerbasamağı = 0 And onbinlerbasamağı = 0 And yüzbinlerbasamağı = 0 And uzunluk >= 3) Or uzunluk < 4 Then GoTo Bitiş
Call sndPlaySound32("E:\11-Sayı Okuma\1-Sesler\Bin.wav", 0)
Bitiş:

End Sub

Sub OnBinlerOku()
uzunluk = Len(Range("A1").Value)
If uzunluk >= 5 Then
onbinlerbasamağı = Right(Left(Range("A1").Value, uzunluk - 4), 1)
End If

If (onbinlerbasamağı = 1 And uzunluk = 4) Or onbinlerbasamağı = 0 Or uzunluk < 4 Then GoTo Bitiş
Call sndPlaySound32("E:\11-Sayı Okuma\1-Sesler\" & onbinlerbasamağı & "0" & ".wav", 0)
Bitiş:

End Sub

Sub YüzbinlerOku()
uzunluk = Len(Range("A1").Value)
If uzunluk >= 6 Then
yüzbinlerbasamağı = Right(Left(Range("A1").Value, uzunluk - 5), 1)
End If

If yüzbinlerbasamağı = 0 Or yüzbinlerbasamağı = 1 Or uzunluk < 6 Then GoTo Bitiş
Call sndPlaySound32("E:\11-Sayı Okuma\1-Sesler\" & yüzbinlerbasamağı & ".wav", 0)
Bitiş:

End Sub


Sub MilyonlarOku()
uzunluk = Len(Range("A1").Value)
If uzunluk >= 7 Then
milyonlarbasamağı = Right(Left(Range("A1").Value, uzunluk - 6), 1)
End If

If (milyonlarbasamağı = 0 Or uzunluk < 7) Then GoTo Bitiş
Call sndPlaySound32("E:\11-Sayı Okuma\1-Sesler\" & milyonlarbasamağı & ".wav", 0)
Bitiş:

End Sub

Sub MilyonOku()
uzunluk = Len(Range("A1").Value)
milyonlarbasamağı = Right(Left(Range("A1").Value, uzunluk - 6), 1)

If (milyonlarbasamağı = 0 And uzunluk < 7) Or uzunluk < 7 Then GoTo Bitiş
Call sndPlaySound32("E:\11-Sayı Okuma\1-Sesler\Milyon.wav", 0)
Bitiş:

End Sub


Sub OnMilyonlarOku()
uzunluk = Len(Range("A1").Value)
If uzunluk >= 8 Then
onmilyonlarbasamağı = Right(Left(Range("A1").Value, uzunluk - 7), 1)
End If

If onmilyonlarbasamağı = 0 Or uzunluk < 8 Then GoTo Bitiş
Call sndPlaySound32("E:\11-Sayı Okuma\1-Sesler\" & onmilyonlarbasamağı & "0" & ".wav", 0)
Bitiş:

End Sub


Sub YüzMilyonlarOku()
uzunluk = Len(Range("A1").Value)
If uzunluk >= 9 Then
yüzmilyonlarbasamağı = Right(Left(Range("A1").Value, uzunluk - 8), 1)
End If

If yüzmilyonlarbasamağı = 0 Or yüzmilyonlarbasamağı = 1 Or uzunluk < 9 Then GoTo Bitiş
Call sndPlaySound32("E:\11-Sayı Okuma\1-Sesler\" & yüzmilyonlarbasamağı & ".wav", 0)
Bitiş:

End Sub

Son olarak ta bir modüle kaydedilecek kodlar;

Declare Function sndPlaySound32 Lib "winmm.dll" Alias "sndPlaySoundA" _
(ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

Vba'yı eğitim almadan öğrendiğim için kodlar pratik olmayabilir.
 
Katılım
12 Aralık 2015
Mesajlar
1,207
Excel Vers. ve Dili
Türkçe Ofis 2007
"Sayıyı Yazıya Çevir" fonksiyonundan, yazıya çevrilen sayıların aralarına bir ayraç karakteri ekleyerek yararlanıp örneğin (ikixbinxaltıxyüzxonxbeş) gibi bir değer üretip onu da split ile diziye çevirmek kodları kısaltmaz mı? Ben biraz uğraştım ama toparlayamadım.
 
Katılım
24 Nisan 2005
Mesajlar
3,671
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
"Sayıyı Yazıya Çevir" fonksiyonundan, yazıya çevrilen sayıların aralarına bir ayraç karakteri ekleyerek yararlanıp örneğin (ikixbinxaltıxyüzxonxbeş) gibi bir değer üretip onu da split ile diziye çevirmek kodları kısaltmaz mı? Ben biraz uğraştım ama toparlayamadım.
Sayıyı yazıya çevirdikten sonra aynı sıra ile dosyaları wav olarak tek dosyadada birleştirip, birleştirilen dosyayı çalıştırmak kodu daha da kısaltacaktır.

@alibaskan,
995 sayısı için birler,onlar,yüzler ses dosyasını dosya.tc ye yükleyebilir mi siniz?
 
Katılım
24 Nisan 2005
Mesajlar
3,671
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
Bu programı indirip kurunuz.

https://sourceforge.net/projects/sox/files/sox/

Ses dosyaları ile aynı klasörde cmd de aşağıdaki şekilde çalıştırınız.

sox bes.wav yuz.wav doksan.wav bes.wav ses.wav

Program sayıları ses.wav dosyasında tek dosya olarak birleştirecektir.

Aşağıdaki kodlar A1 hücresinden sayıları alacak, yazıya çevirecek, yazıdan her sayının dosya adını alıp aşağıdaki şekilde komutu oluşturacak.

Şu an için sadece bu komutu cmd de çalıştırmak kaldı.
Yol bulunamadı hatası alıyorum. Bu da aşılınca program bitmiş olacak.

sox bes.wav yuz.wav doksan.wav bes.wav ses.wav

Kod:
Public sayi, yaziile As String
Dim yazisay() As String
Dim yazilist() As String
   
Declare Function sndPlaySound32 Lib "winmm.dll" Alias "sndPlaySoundA" _
(ByVal lpszSoundName As String, ByVal uFlags As Long) As Long

Public Sub sayioku()
   sayi = Cells(1, 1).Value
   yaziile = tl_yaz(sayi)

   yazilist = Split(yaziile, ",")
   For i = LBound(yazilist) To UBound(yazilist) - 1
     Cells(i + 2, 1).Value = yazilist(i)
     dosya = dosya + yazilist(i) + ".wav "
   Next i
   yol = ActiveWorkbook.Path
   
   dosya = dosya + "ses.wav"
   dosya = yol + "\sox.exe " + dosya
   
   'Shell bölümü eklenecek
   'Shell (dosya)
   
   Call sndPlaySound32("D:\temp\sayisayma\ses.wav", 0)

End Sub

Function tl_yaz(sayi)
On Error Resume Next
Dim deg(3), s(3), deger(2)
a = Array("", "bir,", "iki,", "uc,", "dort,", "bes,", "alti,", "yedi,", "sekiz,", "dokuz,")
b = Array("", "on,", "yirmi,", "otuz,", "kirk,", "elli,", "altmis,", "yetmis,", "seksen,", "doksan,")
c = Array("", "", "bin,", "milyon,", "milyar,", "trilyon,")

deger(1) = Int(sayi)
deger(2) = Round(sayi - deger(1), 2) * 100
If sayi = 0 Then son = "sıfır"
For g = 1 To 2
yazi = deger(g)
For d = 1 To Len(yazi) Step 3
e = e + 1
deg(1) = Mid(yazi, Len(yazi) - d - 1, 1)
deg(2) = Mid(yazi, Len(yazi) - d, 1)
deg(3) = Mid(yazi, Len(yazi) - d + 1, 1)
If deg(1) <> 0 Then s(1) = Replace(a(deg(1)) & "yuz,", "bir,yuz,", "yuz,")
s(2) = b(deg(2))
s(3) = a(deg(3)) & c(e)
If deg(1) + deg(2) + deg(3) = 0 Then s(3) = ""
son = s(1) & s(2) & s(3) & son
If Left(son, 8) = "bir,bin," Then son = Replace(son, "bir,bin,", "bin,")
For f = 1 To 3
deg(f) = ""
s(f) = ""
Next: Next
If g = 1 And deger(1) <> 0 Then tl = son & ""
If g = 2 And deger(2) <> 0 Then kr = "" & son & ""
son = ""
e = 0
Next
tl_yaz = tl & kr
End Function
 
Son düzenleme:

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
İnşallah güzel bir şey çıkacak ortaya.
Az da olsa katkımın olmasına da sevindim doğrusu.

Sayın asri halledecektir mutlaka.
 
Katılım
24 Nisan 2005
Mesajlar
3,671
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
18. mesajda güncelleme yapıldı.
 
Son düzenleme:
Katılım
12 Aralık 2015
Mesajlar
1,207
Excel Vers. ve Dili
Türkçe Ofis 2007
Sayın alibaskan
Ses dosyalarınızın çoğunun linkleri kırık tam deneyemedim ama aşağıdaki kodlar çalışıyor. ses dosyalarınızın adlarını (örneğin 1.wav dosyasının adını bir.wav) değiştirin.
Kod:
Declare Function sndPlaySound32 Lib "winmm.dll" Alias "sndPlaySoundA" _
    (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Function yaziyla(sayi)
On Error Resume Next
Dim deg(3), s(3), deger(2)
a = Array("", " bir", " iki", " üç", " dört", " beş", " altı", " yedi", " sekiz", " dokuz")
b = Array("", " on", " yirmi", " otuz", " kırk", " elli", " altmış", " yetmiş", " seksen", " doksan")
c = Array("", "", " bin", " milyon", " milyar", " trilyon")
deger(1) = Int(sayi)
deger(2) = Round(sayi - deger(1), 2) * 100
If sayi = 0 Then son = "sıfır"
For g = 1 To 2
yazi = deger(g)
For D = 1 To Len(yazi) Step 3
e = e + 1
deg(1) = Mid(yazi, Len(yazi) - D - 1, 1)
deg(2) = Mid(yazi, Len(yazi) - D, 1)
deg(3) = Mid(yazi, Len(yazi) - D + 1, 1)
If deg(1) <> 0 Then s(1) = Replace(a(deg(1)) & " yüz", " bir yüz", " yüz")
s(2) = b(deg(2))
s(3) = a(deg(3)) & c(e)
If deg(1) + deg(2) + deg(3) = 0 Then s(3) = ""
son = s(1) & s(2) & s(3) & son
If Left(son, 8) = " bir bin" Then son = Replace(son, " bir bin", " bin")
For f = 1 To 3
deg(f) = ""
s(f) = ""
Next: Next
If g = 1 And deger(1) <> 0 Then ytl = son

son = ""
e = 0
Next
yaziyla = ytl
yaziyla = Trim(yaziyla)
End Function
Sub brn()
hane = Split(yaziyla(Range("a1")), " ")
For i = 0 To UBound(hane)
yol = "D:\ses\" & hane(i) & ".wav"
Call sndPlaySound32(yol, 0)
Next
End Sub
 
Son düzenleme:

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Bu programı indirip kurunuz.
https://sourceforge.net/projects/sox/files/sox/
Ses dosyaları ile aynı klasörde cmd de aşağıdaki şekilde çalıştırınız.

Şu an için sadece bu komutu cmd de çalıştırmak kaldı.
Yol bulunamadı hatası alıyorum. Bu da aşılınca program bitmiş olacak.

Kod:
   'Shell bölümü eklenecek
   'Shell (dosya)
End Sub
Merhaba Sayın asri.

Cmd ile ilgili olarak aşağıdaki konuya bir bakın isterseniz.
Belki faydası olur.

Makro İle komut satırı çalıştırma
.
 
Katılım
24 Nisan 2005
Mesajlar
3,671
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
Program artık sorunsuz bir şekilde çalışıyor. Deneyiniz.

1- Zip dosyasının içindeki sox-14.4.2-win32 programını kurunuz.
2- Okunmuş sayı grupları aşağıdaki şekilde adlandırılmalıdır.
bir.wav iki.wav uc.wav dort.wav bes.wav alti.wav yedi.wav sekiz.wav dokuz.wav
on.wav yirmi.wav otuz.wav kirk.wav elli.wav altmis.wav yetmis.wav seksen.wav doksan.wav yuz.wav
bin.wav milyon.wav milyar.wav trilyon.wav
3- Program klasörü c:\ sürücüsünde olmalı.
4- Her çalıştığında eski okunmuş dosyayı silecek ve yeniden oluşturacaktır.
5- Kaynak ses dosyasını bulamaz ise "Dosya oluşturulamadı hatası verecektir"

13 haneye kadar sayıları, seslendirebilir siniz.

Ses dosyalarını http://mp3cut.net/tr sitesinde ses kesici ile düzenleyiniz.
sayıların başında ve sonundaki gereksiz boşlukları kesiniz.


http://asriakdeniz.com/excel-sayilari-sesli-okuma-13-hane


 
Son düzenleme:
Katılım
12 Nisan 2007
Mesajlar
170
Excel Vers. ve Dili
Office XP
Sn.asri

Şu an üzerinde çalıştığım bir projede yazı okutmaya çalışıyorum. Öncelikle kelimeleri hecelere ayırma ile başladım. Bu kısım tamam gibi. Sonra her hece için tüm kombinasyonlardaki ses dosyalarını oluşturup tüm Türkçe kelimeleri okuyacak bir kod geliştirmek istiyorum. Sizin yukarıdaki rakam okuma çalışmanızı henüz kurup denemedim. Şayet rakam geçişlerini bendeki kodlara göre daha iyi okuyorsa yazı okumada da kullanılabileceğini düşünüyorum. Çünkü benim ilk yazdığım kodlar wav dosyalarının başını ve sonunu kırptığım halde yarım saniye kadar bir boşlukla okuyor. Bu da insan okumasına göre fark oluşturuyor. Bu konudaki sizin ve diğer arkadaşların görüşlerini merak ediyorum.
 
Katılım
24 Nisan 2005
Mesajlar
3,671
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
Sn.asri

Şu an üzerinde çalıştığım bir projede yazı okutmaya çalışıyorum. Öncelikle kelimeleri hecelere ayırma ile başladım. Bu kısım tamam gibi. Sonra her hece için tüm kombinasyonlardaki ses dosyalarını oluşturup tüm Türkçe kelimeleri okuyacak bir kod geliştirmek istiyorum. Sizin yukarıdaki rakam okuma çalışmanızı henüz kurup denemedim. Şayet rakam geçişlerini bendeki kodlara göre daha iyi okuyorsa yazı okumada da kullanılabileceğini düşünüyorum. Çünkü benim ilk yazdığım kodlar wav dosyalarının başını ve sonunu kırptığım halde yarım saniye kadar bir boşlukla okuyor. Bu da insan okumasına göre fark oluşturuyor. Bu konudaki sizin ve diğer arkadaşların görüşlerini merak ediyorum.
Yazdığım kodlar tek bir wav dosyası oluşturduğu için wav dosyası çalıştığı andan itibaren akıcı olacaktır.

Öncelikle cümleyi kelimelere ve kelimeleri de hecelere bölecek bir kod yazılması gerekiyor.

İlk aşama için heceler ile aynı isimdeki dosyalar arda arda birleştirilip her bir kelime arasına çok kısa bir süre için sessizlik dosyası ekleyip birleştirmek yeterli olacaktır.

Bir cümle için hece olarak seslendirme gönderirseniz bakarım.

Edit:

Seslendirme için program tamamlanmak üzere, kelimeyi hecelemek için serhatmercan@yahoo.com un yazdığı, paylaşıma açık kodları kullandım.
Kelime ayırma ve seslendirme işlemleri için kendim yazıyorum.

X ler boşluk dosyasını temsil edecek.
Merhaba dünya.
mer,ha,ba,X,dün,ya,X,
 
Son düzenleme:
Üst