Sayıyı Rusça Yazıyla Yazma

[kırık_çocuk]

Merhabalar Arkadaşlar,

Başlıkta da belirttiğim gibi, sayıyı Rusça olarak yazıya çevirmek istiyorum. Araştırırken bir makro buldum fakat makroyu yazdığımda kiril ile yazılmış kısımlar soru işaretine dönüşüyor. Nasıl yapabilirim bulamadım en son çareyi başlık açmakta buldum.
Kod:

Function Cur_txt1(cur As Currency, gender As String) As String
Dim str As String
 Dim word As String
 Dim digital As Integer
 Dim c As Currency
 c = cur
 word = ""
 If c < 1000 Then
  digital = Int(c / 100)
  Select Case digital
   Case 1
     word = "сто"
   Case 2
     word = "двести"
   Case 3
     word = "триста"
   Case 4
     word = "четыреста"
   Case 5
     word = "пятьсот"
   Case 6
     word = "шестьсот"
   Case 7
     word = "семьсот"
   Case 8
     word = "восемьсот"
   Case 9
     word = "девятьсот"
  End Select
  str = word
  word = ""
  c = c - digital * 100
  If c > 19 Then
   digital = Int(c / 10)
   Select Case digital
    Case 2
      word = "двадцать"
    Case 3
      word = "тридцать"
    Case 4
      word = "сорок"
    Case 5
      word = "пятьдесят"
    Case 6
      word = "шестьдесят"
    Case 7
      word = "семьдесят"
    Case 8
      word = "восемьдесят"
    Case 9
      word = "девяносто"
   End Select
   If word <> "" Then
     If str <> "" Then
      str = str + " " + word
     Else
      str = word
     End If
   End If
   word = ""
   c = c - digital * 10
  End If
   Select Case c
    Case 1
      word = "один"
    Case 2
      word = "два"
    Case 3
      word = "три"
    Case 4
      word = "четыре"
    Case 5
      word = "пять"
    Case 6
      word = "шесть"
    Case 7
      word = "семь"
    Case 8
      word = "восемь"
    Case 9
      word = "девять"
    Case 10
      word = "десять"
    Case 11
      word = "одиннадцать"
    Case 12
      word = "двенадцать"
    Case 13
      word = "тринадцать"
    Case 14
      word = "четырнадцать"
    Case 15
      word = "пятнадцать"
    Case 16
      word = "шестнадцать"
    Case 17
      word = "семнадцать"
    Case 18
      word = "восемнадцать"
    Case 19
      word = "девятнадцать"
   End Select
   If (c <= 2) And ((gender = "w") Or (gender = "W")) Then
    Select Case c
      Case 1
        word = "одна"
      Case 2
        word = "две"
    End Select
   End If
    If word <> "" Then
     If str <> "" Then
      str = str + " " + word
     Else
      str = word
     End If
    End If
 Else
  If c < 1000000 Then
   str = Cur_txt1(Int(c / 1000), "w")
   word = ""
   Select Case Int(c / 1000) Mod 10
    Case 1
     If Int(c / 1000) Mod 100 = 11 Then
      word = "тысяч"
     Else
      word = "тысяча"
     End If
    Case 2, 3, 4
     If (Int(c / 1000) Mod 100 > 10) And (Int(c / 1000) Mod 100 < 20) Then
      word = "тысяч"
     Else
      word = "тысячи"
     End If
    Case Else
     word = "тысяч"
   End Select
   If word <> "" Then
    str = str + " " + word
   End If
   word = Cur_txt1(c - Int(c / 1000) * 1000, "m")
   If word <> "" Then
    str = str + " " + word
   End If
  Else
   If c < 1000000000 Then
    str = Cur_txt1(Int(c / 1000000), "m")
    Select Case Int(c / 1000000) Mod 10
     Case 1
      If Int(c / 1000000) Mod 100 = 11 Then
       word = "миллионов"
      Else
       word = "миллион"
      End If
     Case 2, 3, 4
     If (Int(c / 1000000) Mod 100 > 10) And (Int(c / 1000000) Mod 100 < 20) Then
      word = "миллионов"
     Else
      word = "миллиона"
     End If
     Case Else
      word = "миллионов"
    End Select
    str = str + " " + word
    word = Cur_txt1(c - Int(c / 1000000) * 1000000, "m")
    If word <> "" Then
     str = str + " " + word
    End If
   Else
  End If
  End If
 End If
 Cur_txt1 = str
End Function
 
Public Function CurText(cur As Currency) As String
  Dim tmp As String
  If cur < 1000000000 Then
    tmp = ""
    If cur >= 1 Then
      tmp = Cur_txt1(Int(cur), "m") & " руб."
    End If
    If cur - Int(cur) >= 0.1 Then
       tmp = tmp & " " & Int((cur - Int(cur)) * 100) & " коп."
    Else
       tmp = tmp & " 0" & Int((cur - Int(cur)) * 100) & " коп."
    End If
    CurText = tmp
  Else
    CurText = ""
  End If
End Function
 
Public Function FirstLetter(str As String) As String
If str <> "" Then
  FirstLetter = UCase(Left(str, 1)) + Right(str, Len(str) - 1)
 Else
  FirstLetter = ""
 End If
End Function

Excel 2010 Türkçe Kullanıyorum.

 

[kırık_çocuk]

Yok mu bilen yardımcı olacak birileri?

 

[mancubus]

rusça dil desteği var mı pc'de..

şu makale bir fikir verebilir:
http://support.microsoft.com/kb/177561/tr

 

[kırık_çocuk]

rusça dil desteği var mı pc'de..

şu makale bir fikir verebilir:
http://support.microsoft.com/kb/177561/tr

Var diye biliyorum. Aslında Rusçaydı Windows vs her şey fakat ben dil paketleriyle Türkçeleştirmiştim.

 

[mancubus]

kiril alfabesi yerine bir takım karakterlerin çıkması makro ile ilgili değil, dil ayarları ile ilgilidir düşüncesindeyim.

google'da "çoklu dil desteği" şeklinde arama yapılırsa, mutlaka bir çözüm çıkacaktır kanısındayım.

 

[sener_izmir]

Üzerinden yıllar geçmiş ama aynı sorun bende de var. Çözebilen var mı

 

[Korhan Ayhan]

Rusça ofis yüklerseniz sorun düzelebilir.

 

[ÖmerBey]

Merhaba,
Ekteki dosyayı deneyiniz...
Harici Link