Сумма прописью нужна. Для Казахстана, что-бы писала тенге, тиины.

[kzld]

Сумма прописью нужна.
Именно для Казахстана, что-бы писала тенге, тиины.
Кто поделится?

[doober]

Все в архиве. AddMsOff.dll скопировать в system32

[kzld]

Сообщение от doober

Все в архиве. AddMsOff.dll скопировать в system32

Большое спасибо

[user7789]

Сообщение от kzld

Большое спасибо

есть макрос, пишет в долл,евро, тг. нужен?

[kzld]

Сообщение от user7789

есть макрос, пишет в долл,евро, тг. нужен?

Нужен. Для коллекции, а если ещё и в тенге !!!!!!!!!

[user7789]

Public Function NumTranslateRus(Refer As Range, CHR_1 As Boolean, WordFOR_1 As String, WordFOR_2_3_4 As String, WordFOR5 As String, _
 Optional WrdFOR_1 As String, Optional WrdFOR_2_3_4 As String, Optional WrdFOR5 As String) As String

Dim Word(3, 9) As String
Dim Wrd(9) As String * 12
Dim stroka, Strich As String
Dim volume, number  As Double
Dim L_nu, L_num As Integer
Dim slov, sl_v1, strMsg As String
Dim prov As Boolean


'Заполнение массива
Word(1, 1) = "од": Word(2, 1) = "десять": Word(3, 1) = "сто"
Word(1, 2) = "дв": Word(2, 2) = "двадцать": Word(3, 2) = "двести"
Word(1, 3) = "три": Word(2, 3) = "тридцать": Word(3, 3) = "триста"
Word(1, 4) = "четыре": Word(2, 4) = "сорок": Word(3, 4) = "четыреста"
Word(1, 5) = "пять": Word(2, 5) = "пятьдесят": Word(3, 5) = "пятьсот"
Word(1, 6) = "шесть": Word(2, 6) = "шестьдесят": Word(3, 6) = "шестьсот"
Word(1, 7) = "семь": Word(2, 7) = "семьдесят": Word(3, 7) = "семьсот"
Word(1, 8) = "восемь": Word(2, 8) = "восемьдесят": Word(3, 8) = "восемьсот"
Word(1, 9) = "девять": Word(2, 9) = "девяносто": Word(3, 9) = "девятьсот"

Wrd(1) = "одиннадцать"
Wrd(2) = "двенадцать"
Wrd(3) = "тринадцать"
Wrd(4) = "четырнадцать"
Wrd(5) = "пятнадцать"
Wrd(6) = "шестнадцать"
Wrd(7) = "семнадцать"
Wrd(8) = "восемнадцать"
Wrd(9) = "девятнадцать"

On Error GoTo errorlabel
prov = True
stroca = ""

volume = Refer.Value

If volume >= 1000000000 Then
   MsgBox "Больше 999999999 перевести не могу", 64, "Внимание"
   Exit Function
 Else
    volume = Abs(volume)
    volume = Format(volume, "########0.00")
    drob = (Format((volume - Int(volume)), "0.00") * 100)
    number = Int(volume)
    prov = False
    
    L_nu = Val(Right(Str(number), 2))
    L_num = Val(Right(Str(number), 1))
    
    If L_nu > 10 And L_nu < 20 And number > 0 Then
     slov = " " + WordFOR5
    Else
     Select Case L_num
      Case 1
       slov = "ин " + WordFOR_1
      Case 2
       slov = "а " + WordFOR_2_3_4
      Case 3, 4
       slov = " " + WordFOR_2_3_4
      Case Else
       slov = " " + WordFOR5
     End Select
     If number = 0 Then slov = ""
    End If
    L_nu = Val(Right(Str(drob), 2))
    L_num = Val(Right(Str(drob), 1))
    
    If L_nu > 10 And L_nu < 20 Then
       sl_v1 = WrdFOR5
    Else
    Select Case L_num
     Case "1"
      sl_v1 = WrdFOR_1
     Case "2", "3", "4"
      sl_v1 = WrdFOR_2_3_4
     Case Else
      sl_v1 = WrdFOR5
    End Select
   End If
 End If
'*******************
Chislo = Str(number)
    GoSub Work3:
    
    Chislo = Str(Int(number / 1000))
    If Chislo >= 1 And Chislo - Int(Chislo / 1000) * 1000 <> 0 Then
        
        L_nu = Val(Right(Str(Chislo), 2))
        L_num = Val(Right(Str(Chislo), 1))
    If L_nu > 10 And L_nu < 20 Then
       Strich = "тысяч"
    Else
    Select Case L_num
     Case "1"
      Strich = "на тысяча"
     Case "2"
      Strich = "е тысячи"
     Case "3", "4"
      Strich = " тысячи"
     Case Else
      Strich = " тысяч"
    End Select
   End If
 
    stroca = Strich + stroca
    GoSub Work3:
    End If
'------------------------------

    Chislo = Str(Int(number / 1000000))
    If Chislo >= 1 Then
        L_nu = Val(Right(Str(Chislo), 2))
    L_num = Val(Right(Str(Chislo), 1))
    
        If L_nu > 10 And L_nu < 20 Then
            Strich = " миллионов"
         Else
            Select Case L_num
             Case "1"
             Strich = "ин миллион"
            Case "2"
            Strich = "а миллиона"
            Case "3", "4"
            Strich = " миллиона"
            Case Else
           Strich = " миллионов"
         End Select
        End If
     
    stroca = Strich + stroca
    GoSub Work3:
    End If

   
   stroca = stroca + slov + " " + IIf(drob < 9, "0" + Trim(Str(drob)), Str(drob)) + " " + sl_v1
If CHR_1 Then
        Dim kl_s As String
        Dim dl_s As Integer
        dl_s = Len(Trim(stroca))
        kl_s = Mid(Trim(stroca), 1, 1)
       stroca = UCase(kl_s) + Mid(Trim(stroca), 2, dl_s)
     Else
    End If
    NumTranslateRus = stroca
Exit Function
Work3: ' подрограмма обработки троек чисел
'*****************
For i = 1 To 3
    L_nu = Val(Right(Chislo, 2))
    L_num = Val(Left(Right(Chislo, i), 1))
 If L_nu > 10 And L_nu < 20 And i = 1 Then
     stroca = " " + Wrd(L_num) + stroca
     i = 2
      GoTo jump:
  Else
     stroca = " " + Word(i, L_num) + stroca
     
 End If
jump:
Next i: Return
'******************

errorlabel:
 If prov Then
    strMsg = "В данную ячейку необходимо записать число" & Chr(13)
    strMsg = strMsg & " Например 1234,23 , исправте запись и запустите" & Chr(13)
    strMsg = strMsg & " сначала"
    MsgBox strMsg, 64, " Ошибка"
 Else
    strMsg = "Возникла ошибка: " & Err.Description & Chr(13)
    strMsg = strMsg & " номер: " & Err.number
    MsgBox strMsg, 64, " Ошибка"
  
 End If
End Function

[user7789]

потом:

=IF(M5="USD"; NumTranslateRus(M21;1;"доллар";"доллара";"долларов";"цент";"цента";"центов");  IF(M5="EUR"; NumTranslateRus(M21;1;"евро";"евро";"евро";"цент";"цента";"центов");  NumTranslateRus(M21;1;"тенге";"тенге";"тенге";"тиын";"тиын";"тиын")))

где ячейка M5 - валюта (USD. eur. KZT)

[user7789]

in an English.

Main Function
Function SpellNumber(ByVal MyNumber, CCY As String)
    Dim Dollars, Cents, Temp
    Dim DecimalPlace, Count
    Dim Curr, Curr2, Currpl, Curr2pl
    Dim stroca As String
    Dim kl_s As String
    Dim dl_s As Integer
    ReDim Place(9) As String
    Place(2) = " thousand "
    Place(3) = " million "
    Place(4) = " billion "
    Place(5) = " trillion "
    ' String representation of amount.
    MyNumber = Trim(Str(MyNumber))
    Select Case CCY
        Case "USD"
            Curr = "dollar"
            Currpl = "dollars"
            Curr2 = "cent"
            Curr2pl = "cents"
        Case "EUR"
            Curr = "euro"
            Currpl = "euro"
            Curr2 = "cent"
            Curr2pl = "cents"
        Case "KZT"
            Curr = "tenge"
            Currpl = "tenge"
            Curr2 = "tiyn"
            Curr2pl = "tiyn"
    End Select
    ' Position of decimal place 0 if none.
    DecimalPlace = InStr(MyNumber, ".")
    ' Convert cents and set MyNumber to dollar amount.
    If DecimalPlace > 0 Then
        Cents = Left(Mid(MyNumber, DecimalPlace + 1) & _
                  "00", 2)
        MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
    End If
    Count = 1
    Do While MyNumber <> ""
        Temp = GetHundreds(Right(MyNumber, 3))
        If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
        If Len(MyNumber) > 3 Then
            MyNumber = Left(MyNumber, Len(MyNumber) - 3)
        Else
            MyNumber = ""
        End If
        Count = Count + 1
    Loop
    Select Case Dollars
        Case ""
            Dollars = ""
        Case "one"
            Dollars = "one " & Curr
         Case Else
            Dollars = Dollars & " " & Currpl
    End Select
    Select Case Cents
        Case ""
            Cents = " and 00 " & Curr2pl
        Case "one"
            Cents = " and one " & Curr2
              Case Else
            Cents = " and " & Cents & " " & Curr2pl
    End Select
    stroca = Dollars & Cents
    dl_s = Len(Trim(stroca))
    kl_s = Mid(Trim(stroca), 1, 1)
    stroca = UCase(kl_s) + Mid(Trim(stroca), 2, dl_s)
    SpellNumber = stroca
End Function
      
' Converts a number from 100-999 into text
Function GetHundreds(ByVal MyNumber)
    Dim Result As String
    If Val(MyNumber) = 0 Then Exit Function
    MyNumber = Right("000" & MyNumber, 3)
    ' Convert the hundreds place.
    If Mid(MyNumber, 1, 1) <> "0" Then
        Result = GetDigit(Mid(MyNumber, 1, 1)) & " hundred "
    End If
    ' Convert the tens and ones place.
    If Mid(MyNumber, 2, 1) <> "0" Then
        Result = Result & GetTens(Mid(MyNumber, 2))
    Else
        Result = Result & GetDigit(Mid(MyNumber, 3))
    End If
    GetHundreds = Result
End Function
      
' Converts a number from 10 to 99 into text.
Function GetTens(TensText)
    Dim Result As String
    Result = ""           ' Null out the temporary function value.
    If Val(Left(TensText, 1)) = 1 Then   ' If value between 10-19...
        Select Case Val(TensText)
            Case 10: Result = "ten"
            Case 11: Result = "eleven"
            Case 12: Result = "twelve"
            Case 13: Result = "thirteen"
            Case 14: Result = "fourteen"
            Case 15: Result = "fifteen"
            Case 16: Result = "sixteen"
            Case 17: Result = "seventeen"
            Case 18: Result = "eighteen"
            Case 19: Result = "nineteen"
            Case Else
        End Select
    Else                                 ' If value between 20-99...
        Select Case Val(Left(TensText, 1))
            Case 2: Result = "twenty "
            Case 3: Result = "thirty "
            Case 4: Result = "forty "
            Case 5: Result = "fifty "
            Case 6: Result = "sixty "
            Case 7: Result = "seventy "
            Case 8: Result = "eighty "
            Case 9: Result = "ninety "
            Case Else
        End Select
        Result = Result & GetDigit _
            (Right(TensText, 1))  ' Retrieve ones place.
    End If
    GetTens = Result
End Function
     
' Converts a number from 1 to 9 into text.
Function GetDigit(Digit)
    Select Case Val(Digit)
        Case 1: GetDigit = "one"
        Case 2: GetDigit = "two"
        Case 3: GetDigit = "three"
        Case 4: GetDigit = "four"
        Case 5: GetDigit = "five"
        Case 6: GetDigit = "six"
        Case 7: GetDigit = "seven"
        Case 8: GetDigit = "eight"
        Case 9: GetDigit = "nine"
        Case Else: GetDigit = ""
    End Select
End Function

[stas77]

Что то не выходит, вс скопировал! Нажал на инстал.файл! Все удачно вроде! НО НЕ ПОЯВЛЯЕТСЯ У МЕНЯ ПРОПИСЬ В КОМАНДАХ, ЕСТЬ ТОЛЬКО ПРОПИСН
Как сделать все правильно?
Хочу бухгалтеру на комп эту фишку поставить!