sesli okutma Hazır Excel Makroları (VBA) | Excel Programları

Makroyu Kopyala

'Excel Makro (VBA) online eğitimleri için: https://www.excelsizeyeter.com/excelsizeyeter.com/udemy_giris.php adresine tıklayınız. Bir eğitim alana bir eğitim bedavadır. İkinci eğitim olarak Excel, Excel pratik çözümler, finans eğitimleri vb. alabilirsiniz. 
 
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

Benzer Sonuçlar
No	Makro Adı
1	Excel'i konuşturmak, seçili hücredeki yazıları sesli okutmak, cümle okutmak
2	sesli okutma
3	textboxu sesli okuma
4	sesli saat
5	a1 deki kelimeyi sesli ve sessiz olarak ayırır
6	textboxta seslileri sayma
7	dolar okutma
8	excel operatörleri hk
9	menü çubuğunun silinmesi ve özel bir menünün oluşturulması
10	30 excel dosyası içinde bir kelime aratma
11	"Pivot Tablo Dilimleme Bağlantıları" Dialog Penceresi
12	dosyanın yolunu ve ismini hücreye yazdırır
13	framede adres bilgisi
14	makrolar kutusu ve makrolar görünsün
15	ayrıntılı aktif hücre adresi
16	userformun çarpı işaretine tıklayınca mesaj kutusuyla uyarı veriyor
17	forma otomatik resim getirme
18	userform 7 userformun çarpı işaretine tıklayınca mesaj kutusuyla uyarı veriyor
19	userformun başindaki kapat butonunu pasif yapar (çarpiya basinca userform kapanmaz)
20	mesaj kutusu örnekleri

Benzer Sonuçlar

Makro Adı

Excel'i konuşturmak, seçili hücredeki yazıları sesli okutmak, cümle okutmak

sesli okutma

textboxu sesli okuma

sesli saat

a1 deki kelimeyi sesli ve sessiz olarak ayırır

textboxta seslileri sayma

dolar okutma

excel operatörleri hk

menü çubuğunun silinmesi ve özel bir menünün oluşturulması

30 excel dosyası içinde bir kelime aratma