VB deki modül adını excel hücresinden seçerek formül içinde oluşturabilmek için...

[KMLZDMR]

Merhaba,
VB deki modülünde rakamı usd,euro,ytl,tl olarak çeviren bir fonksiyon var.
excel L47 hücresinde bu fonksiyonların adları var: seçerek formül içinde oluşturabilmek için...

P47 HÜCRESİNDEKİ FORMÜL P42 hücresindeki rakamı =EĞER(P42=0;"";"-#- "&yazusd(P42)&" -#-") olarak çalışmaktadır.Yani rakamı yazıya çeviriyor.

Ancak, yapmak istediğim ise L47 hücresinde liste halinde YAZUSD;YAZEUR;YAZTL;YAZYTL;YAZ; seçimleri bulunmaktadır.

P47 hücresindeki formülde örneğin yazusd yerine L47 yi hangi formüller yazarsak (=EĞER(P42=0;"";"-#- "&L47(P42)&" -#-"))
bize =EĞER(P42=0;"";"-#- "&yazusd(P42)&" -#-") yazmış gibi sonuç vermesi gerekli. Amacım, L47 de USD,EURO,YTL,TL ye çevirmek istediğimde bir yerden değişiklik yapabilmektir.
Teşekkür ederim.


Visual Basic Düzenleyicideki fonksiyon aşağıdadır. (ayrıca bu fonksiyon TL ye çevirmede Kuruş değerini bende çevirmedi. Nasıl düzeltilir.

'YazYTL(Para) , YazEUR(Para) , YazUSD(Para) foksiyon sayıyı yazıya çevirme

Public Function Yaz(Para)
Dim ParaStr As String
Dim TL As String
If Not IsNumeric(Para) Then GoTo SayiDegil
ParaStr = Format(Abs(Para), "0.00")
TL = Left(ParaStr, Len(ParaStr) - 3)
Yaz = IIf(Para < 0, "Eksi ", "") & Cevir(TL)
Exit Function
SayiDegil:
Yaz = "GİRİLEN DEĞER SAYI DEĞİL!"
End Function
Public Function YazTL(Para)
Dim ParaStr As String
Dim TL As String
If Not IsNumeric(Para) Then GoTo SayiDegil
ParaStr = Format(Abs(Para), "0.00")
TL = Left(ParaStr, Len(ParaStr) - 3)
YazTL = IIf(Para < 0, "Eksi ", "") & Cevir(TL) & " TL"
Exit Function
SayiDegil:
YazTL = "GİRİLEN DEĞER SAYI DEĞİL!"
End Function

Public Function YazYTL(Para)
Dim ParaStr As String
Dim YTL As String, Kurus As String
If Not IsNumeric(Para) Then GoTo SayiDegil
ParaStr = Format(Abs(Para), "0.00")
YTL = Left(ParaStr, Len(ParaStr) - 3)
Kurus = Right(ParaStr, 2)
If YTL = 0 Then
YazYTL = IIf(Para < 0, "Eksi ", "") & Cevir(Kurus) & " KURUŞ"
Else
If Kurus = 0 Then
YazYTL = IIf(Para < 0, "Eksi ", "") & Cevir(YTL) & "-YTL."
Else
YazYTL = IIf(Para < 0, "Eksi ", "") & Cevir(YTL) & "-YTL." & Cevir(Kurus) & "-YENİ KURUŞ."
End If
End If
Exit Function
SayiDegil:
YazYTL = "GİRİLEN DEĞER SAYI DEĞİL!"
End Function
Public Function YazEUR(Para)
Dim ParaStr As String
Dim EUR As String, Kurus As String
If Not IsNumeric(Para) Then GoTo SayiDegil
ParaStr = Format(Abs(Para), "0.00")
EUR = Left(ParaStr, Len(ParaStr) - 3)
Kurus = Right(ParaStr, 2)
If EUR = 0 Then
YazEUR = IIf(Para < 0, "Eksi ", "") & Cevir(Kurus) & " SENT"
Else
If Kurus = 0 Then
YazEUR = IIf(Para < 0, "Eksi ", "") & Cevir(EUR) & "-EUR."
Else
YazEUR = IIf(Para < 0, "Eksi ", "") & Cevir(EUR) & "-EUR." & Cevir(Kurus) & "-SENT."
End If
End If
Exit Function
SayiDegil:
YazEUR = "GİRİLEN DEĞER SAYI DEĞİL!"
End Function
Public Function YazUSD(Para)
Dim ParaStr As String
Dim USD As String, Kurus As String
If Not IsNumeric(Para) Then GoTo SayiDegil
ParaStr = Format(Abs(Para), "0.00")
USD = Left(ParaStr, Len(ParaStr) - 3)
Kurus = Right(ParaStr, 2)
If USD = 0 Then
YazUSD = IIf(Para < 0, "Eksi ", "") & Cevir(Kurus) & " SENT"
Else
If Kurus = 0 Then
YazUSD = IIf(Para < 0, "Eksi ", "") & Cevir(USD) & "-USD."
Else
YazUSD = IIf(Para < 0, "Eksi ", "") & Cevir(USD) & "-USD." & Cevir(Kurus) & "-SENT."
End If
End If
Exit Function
SayiDegil:
YazUSD = "GİRİLEN DEĞER SAYI DEĞİL!"
End Function

Private Function Cevir(SayiStr As String) As String
Dim Rakam(15)
Dim c(3), Sonuc, e
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")
Binler = Array("TRİLYON", "MİLYAR", "MİLYON", "BİN", "")
SayiStr = String(15 - Len(SayiStr), "0") + SayiStr
For i = 1 To 15
Rakam(i) = Val(Mid$(SayiStr, i, 1))
Next i
Sonuc = ""
For i = 0 To 4
c(1) = Rakam(i * 3 + 1)
c(2) = Rakam(i * 3 + 2)
c(3) = Rakam(i * 3 + 3)
If c(1) = 0 Then
e = ""
ElseIf c(1) = 1 Then
e = "YÜZ"
Else
e = Birler(c(1)) + "YÜZ"
End If
e = e + Onlar(c(2)) + Birler(c(3))
If e <> "" Then e = e + Binler(i)
If (i = 3) And (e = "BİRBİN") Then e = "BİN"
Sonuc = Sonuc + e
Next i
If Sonuc = "" Then Sonuc = "00"
Cevir = UCase(Mid(Sonuc, 1, 1)) + Mid(Sonuc, 2, Len(Sonuc) - 1)
End Function

 

[Haluk]

Aşağıdaki fonksiyonu eski bir dosyamda buldum, sizin işinize yarayabilir.

P42 hücresinde yer alan değeri yazdırmak için kullanımı;

=YazPara(P42;"USD")

veya, para birimleri L47 hücresindeyse; (TL, YTL, USD, EUR)

=YazPara(P42;L47)

Aşağıdakileri bir modüle yerleştirip, fonksiyonu yukarıda verdiğim örneklerdeki gibi kullanın.

' ****************************************************************************
' * Bu kodlar http://www.excel.gen.tr/?s=2.1&k=75 adresinden indirilmiş olan *
' * comma.xls dosyasından alınmış olup gerekli düzenlemeler yapılmıştır.     *
' * Kodların kullanımı sonucunda oluşacabilecek hatalar ve tüm sorumluluk    *
' * kullanıcıya aittir.                                                      *
' *                                                                          *
' *                              Haluk ®                                     *
' *                             Eylul 2004                                   *
' * **************************************************************************

Function YazPara(ByVal Sayi, Birim As String)

    Dim Lira, Kurus, Temp
    Dim Basamak, Say
    
    Select Case Birim
        Case "TL"
            Birim1 = "TL"
            Birim2 = "Kuruş"
        Case "YTL"
            Birim1 = "YTL"
            Birim2 = "Yeni Kuruş"
        Case "EUR"
            Birim1 = "EUR"
            Birim2 = "Cent"
        Case "USD"
            Birim1 = "USD"
            Birim2 = "Cent"
    End Select

    ReDim Hane(9) As String
    Hane(2) = " Bin "
    Hane(3) = " Milyon "
    Hane(4) = " Milyar "
    Hane(5) = " Trilyon "

    Sayi = Trim(Str(Sayi))

    Basamak = InStr(Sayi, ".")
    
    If Basamak > 0 Then
        Kurus = Onlar(Left(Mid(Sayi, Basamak + 1) & "00", 2))
        Sayi = Trim(Left(Sayi, Basamak - 1))
    End If

    Say = 1
    Do While Sayi <> ""
       Temp = Yuzler(Right(Sayi, 3))
       If Temp <> "" Then Lira = Temp & Hane(Say) & Lira
          If Len(Sayi) > 3 Then
             Sayi = Left(Sayi, Len(Sayi) - 3)
        Else
            Sayi = ""
        End If
        Say = Say + 1
    Loop

    Select Case Lira
        Case ""
            Lira = "Sıfır " & Birim1
        Case "Bir"
            Lira = "Bir " & Birim1
        Case Else
            Lira = Lira & " " & Birim1
    End Select
    
    Lira = WorksheetFunction.Substitute(Lira, "Bir Bin", "Bin", 1)
    Lira = WorksheetFunction.Substitute(Lira, "Bir Yüz", "Yüz", 1)

    Select Case Kurus
        Case ""
            Kurus = " ve Sıfır " & Birim2
        Case "One"
            Kurus = " ve Bir " & Birim2
        Case Else
            Kurus = " ve " & Kurus & " " & Birim2
    End Select

    YazPara = Lira & Kurus
End Function
'
Function Yuzler(ByVal Sayi)
    Dim Result As String

    If Val(Sayi) = 0 Then Exit Function
    Sayi = Right("000" & Sayi, 3)

    If Mid(Sayi, 1, 1) <> "0" Then
        Result = Rakkam(Mid(Sayi, 1, 1)) & " Yüz "
    End If

    If Mid(Sayi, 2, 1) <> "0" Then
        Result = Result & Onlar(Mid(Sayi, 2))
    Else
        Result = Result & Rakkam(Mid(Sayi, 3))
    End If

    Yuzler = Result
End Function
'
Function Onlar(OnlarBasamak)
    Dim Result As String

    Result = ""
    If Val(Left(OnlarBasamak, 1)) = 1 Then
        Select Case Val(OnlarBasamak)
            Case 10: Result = "On"
            Case 11: Result = "Onbir"
            Case 12: Result = "Oniki"
            Case 13: Result = "Onüç"
            Case 14: Result = "Ondört"
            Case 15: Result = "Onbeş"
            Case 16: Result = "Onaltı"
            Case 17: Result = "Onyedi"
            Case 18: Result = "Onsekiz"
            Case 19: Result = "Ondokuz"
            Case Else
        End Select
      Else
        Select Case Val(Left(OnlarBasamak, 1))
            Case 2: Result = "Yirmi "
            Case 3: Result = "Otuz "
            Case 4: Result = "Kırk "
            Case 5: Result = "Elli "
            Case 6: Result = "Altmış "
            Case 7: Result = "Yetmiş "
            Case 8: Result = "Seksen "
            Case 9: Result = "Doksan "
            Case Else
        End Select
         Result = Result & Rakkam(Right(OnlarBasamak, 1))
      End If
      Onlar = Result
   End Function
'
Function Rakkam(Deger)
    Select Case Val(Deger)
        Case 1: Rakkam = "Bir"
        Case 2: Rakkam = "İki"
        Case 3: Rakkam = "Üç"
        Case 4: Rakkam = "Dört"
        Case 5: Rakkam = "Beş"
        Case 6: Rakkam = "Altı"
        Case 7: Rakkam = "Yedi"
        Case 8: Rakkam = "Sekiz"
        Case 9: Rakkam = "Dokuz"
        Case Else: Rakkam = ""
    End Select
End Function

 

[KMLZDMR]

teşekkür ederim.

 

[Haluk]

Kolay gelsin ...

.