:yardim:
arkadaşlar hepinize kolay gelsin aranıza yeni katıldım ama bu işle uğraşıyorum access benim için önemli fakat tabiki bilginin sınırı yok paylaşmak en güzeli ve benimde sizlerin yardımına ihtiyacım var .
aşağıdaki yazılı kodu başka bir bascıc ocx dosyasından access e uyarladım
enson usercontrol read ve write özelliklerinde birkaç değişiklik yaptım ve access e uyarladım fakat bu benim işimi yarım gördü yani eksiklik var ve tamamlamak istiyorum. Hata şu kuruş hanesini çeviremiyor düz rakamı yani 5.000,00 yada 5.225,00 gibi rakamı çeviriyor kuruşu çeviremiyor 5.225,25 ise bunu çeviremiyor .
ben hatamı biliyorum fakat basamak değerleri ve basamak sayılarını sıralamada ve birleştirmede eksik işlemim var fakat çözümü bulamadım.
yardımcı olabilecek arkadaş varsa sevinirim . kolay gelsin
Option Explicit
'SAY.OCX erdogan yildiz
Dim yazi, sayi
Function yaziya_cevir(S) As String
Dim sayi As String
sayi = S
Dim max_basamak_say
max_basamak_say = 18 '18 basamaklı yani katrilyon, dahada artırılabilir.
ReDim birler(10), onlar(10), binler(max_basamak_say / 3), bas(3)
birler = Array("", "BİR", "İKİ", "ÜÇ", "DÖRT", "BEŞ", "ALTI", "YEDİ", "SEKİZ", "DOKUZ")
onlar = Array("", "ON", "YİRMİ", "OTUZ", "KIRK", "ELLİ", "ALTMIŞ", "YETMİŞ", "SEKSEN", "DOKSAN")
'eğer 18 basamaktan daha fazla kullanacaksanız katrilyondan önce 0 basamakları da ekleyin.
binler = Array("KATRİLYON", "TİRİLYON", "MİLYAR", "MİLYON", "BİN", "")
Dim I, uz, sonuc, arasonuc
uz = Len(sayi)
'Sayının kullanılmayan basamaklarını sıfırla doldur
sayi = String(max_basamak_say - uz, "0") + sayi
For I = 0 To max_basamak_say / 3 - 1
'sayıyı üçerli basamaklar halinde ele al
bas(1) = Mid(sayi, (I * 3) + 1, 1) 'üçlü basamaktaki birinci sayı yani yüzler basamağı.
bas(2) = Mid(sayi, (I * 3) + 2, 1) 'üçlü basamaktaki ikinci.yani onlar
bas(3) = Mid(sayi, (I * 3) + 3, 1) 'üçlü basamaktaki üçüncü.yani birler
If bas(1) = 0 Then
arasonuc = "" 'yüzler basamağı boş
Else
If bas(1) = 1 Then
arasonuc = "YÜZ" 'yüzler basamağında 1 varsa 1 yüz olmaz sadece yüz
Else
arasonuc = birler(bas(1)) + "YÜZ" 'yüzler basamağındaki sayi ve yüz ikiyüz gibi.
End If
End If
'yüzler+onlar+birler basamağını birleştir
arasonuc = arasonuc + onlar(bas(2)) + birler(bas(3))
'basamaktaki değer oluşmadıysa yani 000 şeklindeyse binler basamağını ekle.
If arasonuc <> "" Then arasonuc = arasonuc + binler(I)
'birbin olmaz
If (I > 1) And (arasonuc = "BİRBİN") Then arasonuc = "BİN"
sonuc = sonuc + arasonuc + ""
Next
If sonuc = "" Then sonuc = "SIFIR"
yaziya_cevir = sonuc & ". YTL"
End Function
Public Property Get sayı() As Variant
sayı = sayi
End Property
Public Property Let sayı(ByVal vNewValue As Variant)
yazi = yaziya_cevir(vNewValue)
sayi = vNewValue
End Property
Public Property Get yazı() As Variant
yazı = yazi
End Property
Public Property Let yazı(ByVal vNewValue As Variant)
yazı = yazi
End Property
Private Sub UserControl_ReadProperties(PropBag As Property)
yazi = PropBag.Properties("Yazı", yazi)
sayi = PropBag.Properties("Sayı", sayi)
End Sub
Private Sub UserControl_WriteProperties(PropBag As Property)
Call PropBag.Properties("Sayı", sayi)
Call PropBag.Properties("Yazı", yazi)
End Sub
arkadaşlar hepinize kolay gelsin aranıza yeni katıldım ama bu işle uğraşıyorum access benim için önemli fakat tabiki bilginin sınırı yok paylaşmak en güzeli ve benimde sizlerin yardımına ihtiyacım var .
aşağıdaki yazılı kodu başka bir bascıc ocx dosyasından access e uyarladım
enson usercontrol read ve write özelliklerinde birkaç değişiklik yaptım ve access e uyarladım fakat bu benim işimi yarım gördü yani eksiklik var ve tamamlamak istiyorum. Hata şu kuruş hanesini çeviremiyor düz rakamı yani 5.000,00 yada 5.225,00 gibi rakamı çeviriyor kuruşu çeviremiyor 5.225,25 ise bunu çeviremiyor .
ben hatamı biliyorum fakat basamak değerleri ve basamak sayılarını sıralamada ve birleştirmede eksik işlemim var fakat çözümü bulamadım.
yardımcı olabilecek arkadaş varsa sevinirim . kolay gelsin
Option Explicit
'SAY.OCX erdogan yildiz
Dim yazi, sayi
Function yaziya_cevir(S) As String
Dim sayi As String
sayi = S
Dim max_basamak_say
max_basamak_say = 18 '18 basamaklı yani katrilyon, dahada artırılabilir.
ReDim birler(10), onlar(10), binler(max_basamak_say / 3), bas(3)
birler = Array("", "BİR", "İKİ", "ÜÇ", "DÖRT", "BEŞ", "ALTI", "YEDİ", "SEKİZ", "DOKUZ")
onlar = Array("", "ON", "YİRMİ", "OTUZ", "KIRK", "ELLİ", "ALTMIŞ", "YETMİŞ", "SEKSEN", "DOKSAN")
'eğer 18 basamaktan daha fazla kullanacaksanız katrilyondan önce 0 basamakları da ekleyin.
binler = Array("KATRİLYON", "TİRİLYON", "MİLYAR", "MİLYON", "BİN", "")
Dim I, uz, sonuc, arasonuc
uz = Len(sayi)
'Sayının kullanılmayan basamaklarını sıfırla doldur
sayi = String(max_basamak_say - uz, "0") + sayi
For I = 0 To max_basamak_say / 3 - 1
'sayıyı üçerli basamaklar halinde ele al
bas(1) = Mid(sayi, (I * 3) + 1, 1) 'üçlü basamaktaki birinci sayı yani yüzler basamağı.
bas(2) = Mid(sayi, (I * 3) + 2, 1) 'üçlü basamaktaki ikinci.yani onlar
bas(3) = Mid(sayi, (I * 3) + 3, 1) 'üçlü basamaktaki üçüncü.yani birler
If bas(1) = 0 Then
arasonuc = "" 'yüzler basamağı boş
Else
If bas(1) = 1 Then
arasonuc = "YÜZ" 'yüzler basamağında 1 varsa 1 yüz olmaz sadece yüz
Else
arasonuc = birler(bas(1)) + "YÜZ" 'yüzler basamağındaki sayi ve yüz ikiyüz gibi.
End If
End If
'yüzler+onlar+birler basamağını birleştir
arasonuc = arasonuc + onlar(bas(2)) + birler(bas(3))
'basamaktaki değer oluşmadıysa yani 000 şeklindeyse binler basamağını ekle.
If arasonuc <> "" Then arasonuc = arasonuc + binler(I)
'birbin olmaz
If (I > 1) And (arasonuc = "BİRBİN") Then arasonuc = "BİN"
sonuc = sonuc + arasonuc + ""
Next
If sonuc = "" Then sonuc = "SIFIR"
yaziya_cevir = sonuc & ". YTL"
End Function
Public Property Get sayı() As Variant
sayı = sayi
End Property
Public Property Let sayı(ByVal vNewValue As Variant)
yazi = yaziya_cevir(vNewValue)
sayi = vNewValue
End Property
Public Property Get yazı() As Variant
yazı = yazi
End Property
Public Property Let yazı(ByVal vNewValue As Variant)
yazı = yazi
End Property
Private Sub UserControl_ReadProperties(PropBag As Property)
yazi = PropBag.Properties("Yazı", yazi)
sayi = PropBag.Properties("Sayı", sayi)
End Sub
Private Sub UserControl_WriteProperties(PropBag As Property)
Call PropBag.Properties("Sayı", sayi)
Call PropBag.Properties("Yazı", yazi)
End Sub