Страница 1 из 1

Сделать сумму прописью в отчете Microsoft Access

Добавлено: 17 май 2004, 15:29
dkerk
Подскажите как сделать, чтобы в отчете сумма цифрами в одном поле преобразовывалась в сумму прописью в другом?

Добавлено: 18 май 2004, 00:59
Naeel Maqsudov

Код: Выделить всё

Option Explicit

Function Unit(ByVal X As Long, ByVal Form1 As String, ByVal Form234 As String, ByVal FormOther As String) As String
  Select Case X Mod 100
    Case 10 To 20
      Unit = FormOther
    Case Else
      Select Case X Mod 10
         Case 1
           Unit = Form1
         Case 2
           If Form234 = " тысячи " Then
             Unit = "е тысячи "
           ElseIf Form234 = " копейки" Then
             Unit = Form234
           Else
             Unit = "а" & Form234
           End If
         Case 3 To 4
           Unit = Form234
         Case Else
           Unit = FormOther
      End Select
  End Select
End Function

Public Function CardText(ByVal XX As Currency) As String
'On Error GoTo err
Dim Triade As Currency, X As Currency, R As String, i As Byte, Units, Ones, Tens, Hundreds
Units = Array( _
  Array(" копейка", " копейки", " копеек"), _
  Array("ин рубль ", " рубля ", " рублей "), _
  Array("на тысяча ", " тысячи ", " тысяч "), _
  Array("ин миллион ", " миллиона ", " миллионов "), _
  Array("ин миллиард ", " миллиарда ", " миллиардов "), _
  Array("ин триллион ", " триллиона ", " триллионов "), _
  Array(" ? ", " ? ", " ? "), _
  Array(" ? ", " ? ", " ? "))
Ones = Array("", "од", "дв", "три", "четыре", "пять", "шесть", "семь", "восемь", "девять", "десять", "одиннадцать", "двенадцать", "тринадцать", "четырнадцать", "пятнадцать", "шестнадцать", "семнадцать", "восемнадцать", "девятнадцать")
Tens = Array("", "десять ", "двадцать ", "тридцать ", "сорок ", "пятьдесят ", "шестьдесят ", "семьдесят ", "восемьдесят ", "девяносто ")
Hundreds = Array("", "сто ", "двести ", "триста ", "четыреста ", "пятьсот ", "шестьсот ", "семьсот ", "восемьсот ", "девятьсот ")
XX = XX + 0.005
X = Int(XX)
Triade = Int((XX - X) * 100)
R = Format(Triade, "00") + Unit(Triade, Units(0)(0), Units(0)(1), Units(0)(2))
If XX = 0 Then CardText = "Ноль рублей " & R: Exit Function
i = 0
While X > 0
  Triade = (X / 1000 - Int(X / 1000)) * 1000: X = Int(X / 1000): i = i + 1
  If Triade <> 0 Or i < 2 Then
    Select Case Triade Mod 100
    Case 1 To 19
      R = Hundreds(Triade \ 100) & Ones(Triade Mod 100) & Unit(Triade, Units(i)(0), Units(i)(1), Units(i)(2)) & R
    Case Else
      R = Hundreds(Triade \ 100) & Tens((Triade Mod 100) \ 10) & Ones(Triade Mod 10) & Unit(Triade, Units(i)(0), Units(i)(1), Units(i)(2)) & R
    End Select
  End If
Wend
R = Trim(R)
CardText = UCase(Left(R, 1)) & LCase(Mid(R, 2))
Exit Function
err:
CardText = "#ош."
End Function


В ячейке соответственно пишем

=CardText(<ссылка или выражение>)

Это усеченный вариант моей фунуции, которая может записывать суммы прописью в рублях и долларах США в любом падеже русского языка. Полный вариант есть на ObjectPascal.

Пишет - #имя?

Добавлено: 18 май 2004, 09:11
dkerk
Не получилось. Сохранил эту функцию и в строке пишет - #имя?

Добавлено: 22 май 2004, 22:05
Naeel Maqsudov
1. Нажимает Ctrl-F11 - переходим в редактор VBA.
2. Добавляем в проект модуль
3. Добавляем в модуль код двух функций
4. Возвращаемя на рабочий лист и вызываем в ячейке функция CardText

PS
Ошибка #имя означает, что в ячейку введена формула содержащая некорректное имя функции, адрес ячейки или имя диапазона. Т.е. ошибка #имя к приведенномцу выше коду функций отношения не имеет.

Re: Сделать сумму прописью в отчете Microsoft Access

Добавлено: 09 июн 2013, 23:08
Урий
Уважаемый Naeel Maqsudov! Несколько лет использовал Ваш код в своих отчетах Access. Без проблем. Но после перехода в Access 2010 функция перестала работать, точнее, мне удалось ее адаптировать, но суммы она теперь пишет только с маленькой буквы, а в финансовых документах необходимо, чтобы написание сумм начиналось с большой буквы. Прошу, доработайте код и выложите здесь, чтобы можно было и дальше работать. Заранее спасибо.

Теперешний код, который работает в Access 2010 прилагаю:
__________________________________________________________________________________
Option Explicit

Function Unit(ByVal X As Long, ByVal Form1 As String, ByVal Form234 As String, ByVal FormOther As String) As String
Select Case X Mod 100
Case 10 To 20
Unit = FormOther
Case Else
Select Case X Mod 10
Case 1
Unit = Form1
Case 2
If Form234 = " тысячи " Then
Unit = "е тысячи "
ElseIf Form234 = " копейки" Then
Unit = Form234
Else
Unit = "а" & Form234
End If
Case 3 To 4
Unit = Form234
Case Else
Unit = FormOther
End Select
End Select
End Function

Public Function CardText(ByVal XX As Currency) As String
'On Error GoTo err
Dim Triade As Currency, X As Currency, R As String, i As Byte, Units, Ones, Tens, Hundreds
Units = Array( _
Array(" копейка", " копейки", " копеек"), _
Array("ин белорусский рубль ", " белорусских рубля ", " белорусских рублей "), _
Array("на тысяча ", " тысячи ", " тысяч "), _
Array("ин миллион ", " миллиона ", " миллионов "), _
Array("ин миллиард ", " миллиарда ", " миллиардов "), _
Array("ин триллион ", " триллиона ", " триллионов "), _
Array(" ? ", " ? ", " ? "), _
Array(" ? ", " ? ", " ? "))
Ones = Array("", "од", "дв", "три", "четыре", "пять", "шесть", "семь", "восемь", "девять", "десять", "одиннадцать", "двенадцать", "тринадцать", "четырнадцать", "пятнадцать", "шестнадцать", "семнадцать", "восемнадцать", "девятнадцать")
Tens = Array("", "десять ", "двадцать ", "тридцать ", "сорок ", "пятьдесят ", "шестьдесят ", "семьдесят ", "восемьдесят ", "девяносто ")
Hundreds = Array("", "сто ", "двести ", "триста ", "четыреста ", "пятьсот ", "шестьсот ", "семьсот ", "восемьсот ", "девятьсот ")
XX = XX + 0.005
X = Int(XX)
Triade = Int((XX - X) * 100)
If XX = 0 Then CardText = "Ноль рублей " & R: Exit Function
i = 0
While X > 0
Triade = (X / 1000 - Int(X / 1000)) * 1000: X = Int(X / 1000): i = i + 1
If Triade <> 0 Or i < 2 Then
Select Case Triade Mod 100
Case 1 To 19
R = Hundreds(Triade \ 100) & Ones(Triade Mod 100) & Unit(Triade, Units(i)(0), Units(i)(1), Units(i)(2)) & R
Case Else
R = Hundreds(Triade \ 100) & Tens((Triade Mod 100) \ 10) & Ones(Triade Mod 10) & Unit(Triade, Units(i)(0), Units(i)(1), Units(i)(2)) & R
End Select
End If
Wend
CardText = R
Exit Function
err:
CardText = "#ош."
End Function
__________________________________________________________________________

Re: Сделать сумму прописью в отчете Microsoft Access

Добавлено: 10 июн 2013, 17:16
Naeel Maqsudov
Хм, а где конкретно возникает ошибка, если взять исходный код без изменений в Access 2010? (т.е. в какой строке и какая?)
(Я не использую Access 2010, и мне не на чем посмотреть)

Re: Сделать сумму прописью в отчете Microsoft Access

Добавлено: 11 июн 2013, 10:25
Урий
Здравствуйте.
"R = Trim(R)
CardText = UCase(Left(R, 1)) & LCase(Mid(R, 2))"
Вот эти строки из Вашего кода не работают в Access 2010.

Re: Сделать сумму прописью в отчете Microsoft Access

Добавлено: 11 июн 2013, 10:46
Урий
Однако, чтобы сообщить, как ругается база данных на Ваш код, я снова его применил и он теперь работает, как и раньше в Access 2007! Странно. Возможно, это связано с моими экспериментами над другими кодами и модулями? Но теперь работает в Access 2010. Даже не знаю, что еще сказать. Работает и пишет с большой буквы суммы прописью. В любом случае, спасибо. Буду пользоваться дальше.