Как сделать в Access что бы допустим вводишь какое нибудь, а потом нажимаешь кнопку и он это число показывает буквами!! ! Если есть у кого нибудь исходники скиньте пожалуйста!! !
P.S. Заранее спасибо!!!!
Другие языки программирования и технологии
Access
Доброго времени суток.
Ключевая фраза для поиска "сумма прописью". Можете попробовать такой вариант. Когда-то портировал из Delphi.
' Преобразование числа в его строковый эквивалент
' Вход: 15-ти разрядное число, включая десятичные знаки
' (дробная часть округляется до сотых)
'
Function Прописью (RValue As Currency) As String
' Максимальное количество триад
Const MAX3 = 5
' Массивы числительных
Dim A11 As Variant
Dim A1 As Variant
Dim A10 As Variant
Dim A100 As Variant
Dim A0(MAX3 - 1, 3) As String
' Локальные переменные
Dim Value As Currency
Dim V As Currency
Dim i100 As Integer
Dim i10 As Integer
Dim i1 As Integer
Dim p As Integer
Dim n As Integer
Dim Sign As String
Dim S As String
Dim K As String
A1 = Array("", "один ", "два ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", _
"девять ", "десять ", "одиннадцать ", "двенадцать ", "тринадцать ", "четырнадцать ", _
"пятнадцать ", "шестнадцать ", "семнадцать ", "восемнадцать ", "девятнадцать ")
A11 = Array("", "одна ", "две ")
A10 = Array("", "десять ", "двадцать ", "тридцать ", "сорок ", "пятьдесят ", "шестьдесят ", _
"семьдесят ", "восемьдесят ", "девяносто ")
A100 = Array("", "сто ", "двести ", "триста ", "четыреста ", "пятьсот ", "шестьсот ", _
"семьсот ", "восемьсот ", "девятьсот ")
' Четвертый параметр - род: 1 - мужской; 0 - женский
A0(0, 0) = "рубль"
A0(0, 1) = "рубля"
A0(0, 2) = "рублей"
A0(0, 3) = "1"
A0(1, 0) = "тысяча"
A0(1, 1) = "тысячи"
A0(1, 2) = "тысяч"
A0(1, 3) = "0"
A0(2, 0) = "миллион"
A0(2, 1) = "миллиона"
A0(2, 2) = "миллионов"
A0(2, 3) = "1"
A0(3, 0) = "миллиард"
A0(3, 1) = "миллиарда"
A0(3, 2) = "миллиардов"
A0(3, 3) = "1"
A0(4, 0) = "триллион"
A0(4, 1) = "триллиона"
A0(4, 2) = "триллионов"
A0(4, 3) = "1"
Value = Fix(RValue)
' Выделение дробной части и преобразование ее в строку с округлением до сотых
n = Int(Abs(RValue - Value) * 100 + 0.5)
' Если есть дробная часть, записать копейки
If n = 0 Then
K = ""
Else
K = Str(n) + " коп"
End If
' Обработка отрицательного значения и нуля
If RValue < 0 Then
Sign = "минус "
Value = -Value
ElseIf Value = 0 Then
Sign = "ноль "
Else
Sign = ""
End If
n = 0
Do
' Выделение последней триады
V = Value - (Int(Value / 1000)) * 1000
Value = Int(Value / 1000)
' Обработка триады
If (V > 0) Or (n = 0) Then
i100 = V \ 100
V = V - i100 * 100
If V >= 20 Then
i1 = V Mod 10
V = V \ 10
i10 = V Mod 10
Else
i1 = V
i10 = 0
End If
Select Case i1
Case 1
p = 0
Case 2 To 4
p = 1
Case Else
p = 2
End Select
' Приведение к женскому или мужскому роду
If (A0(n, 3) = "0") And ((i1 = 1) Or (i1 = 2)) Then
S = A100(i100) + A10(i10) + A11(i1) + A0(n, p) + " " + S
Else
S = A100(i100) + A10(i10) + A1(i1) + A0(n, p) + " " + S
End If
End If
n = n + 1
' Проверка выхода за максимальное количество триад
If n > MAX3 Then Exit Function
Loop Until Value <= 0
If Sign = "ноль " Then
Sign = ""
S = ""
ElseIf S = "рублей " Then
S = ""
End If
S = Sign + S + K
Прописью = UCase(Mid(S, 1, 1)) + Mid(S, 2)
End Function
Удачи!
Ключевая фраза для поиска "сумма прописью". Можете попробовать такой вариант. Когда-то портировал из Delphi.
' Преобразование числа в его строковый эквивалент
' Вход: 15-ти разрядное число, включая десятичные знаки
' (дробная часть округляется до сотых)
'
Function Прописью (RValue As Currency) As String
' Максимальное количество триад
Const MAX3 = 5
' Массивы числительных
Dim A11 As Variant
Dim A1 As Variant
Dim A10 As Variant
Dim A100 As Variant
Dim A0(MAX3 - 1, 3) As String
' Локальные переменные
Dim Value As Currency
Dim V As Currency
Dim i100 As Integer
Dim i10 As Integer
Dim i1 As Integer
Dim p As Integer
Dim n As Integer
Dim Sign As String
Dim S As String
Dim K As String
A1 = Array("", "один ", "два ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", _
"девять ", "десять ", "одиннадцать ", "двенадцать ", "тринадцать ", "четырнадцать ", _
"пятнадцать ", "шестнадцать ", "семнадцать ", "восемнадцать ", "девятнадцать ")
A11 = Array("", "одна ", "две ")
A10 = Array("", "десять ", "двадцать ", "тридцать ", "сорок ", "пятьдесят ", "шестьдесят ", _
"семьдесят ", "восемьдесят ", "девяносто ")
A100 = Array("", "сто ", "двести ", "триста ", "четыреста ", "пятьсот ", "шестьсот ", _
"семьсот ", "восемьсот ", "девятьсот ")
' Четвертый параметр - род: 1 - мужской; 0 - женский
A0(0, 0) = "рубль"
A0(0, 1) = "рубля"
A0(0, 2) = "рублей"
A0(0, 3) = "1"
A0(1, 0) = "тысяча"
A0(1, 1) = "тысячи"
A0(1, 2) = "тысяч"
A0(1, 3) = "0"
A0(2, 0) = "миллион"
A0(2, 1) = "миллиона"
A0(2, 2) = "миллионов"
A0(2, 3) = "1"
A0(3, 0) = "миллиард"
A0(3, 1) = "миллиарда"
A0(3, 2) = "миллиардов"
A0(3, 3) = "1"
A0(4, 0) = "триллион"
A0(4, 1) = "триллиона"
A0(4, 2) = "триллионов"
A0(4, 3) = "1"
Value = Fix(RValue)
' Выделение дробной части и преобразование ее в строку с округлением до сотых
n = Int(Abs(RValue - Value) * 100 + 0.5)
' Если есть дробная часть, записать копейки
If n = 0 Then
K = ""
Else
K = Str(n) + " коп"
End If
' Обработка отрицательного значения и нуля
If RValue < 0 Then
Sign = "минус "
Value = -Value
ElseIf Value = 0 Then
Sign = "ноль "
Else
Sign = ""
End If
n = 0
Do
' Выделение последней триады
V = Value - (Int(Value / 1000)) * 1000
Value = Int(Value / 1000)
' Обработка триады
If (V > 0) Or (n = 0) Then
i100 = V \ 100
V = V - i100 * 100
If V >= 20 Then
i1 = V Mod 10
V = V \ 10
i10 = V Mod 10
Else
i1 = V
i10 = 0
End If
Select Case i1
Case 1
p = 0
Case 2 To 4
p = 1
Case Else
p = 2
End Select
' Приведение к женскому или мужскому роду
If (A0(n, 3) = "0") And ((i1 = 1) Or (i1 = 2)) Then
S = A100(i100) + A10(i10) + A11(i1) + A0(n, p) + " " + S
Else
S = A100(i100) + A10(i10) + A1(i1) + A0(n, p) + " " + S
End If
End If
n = n + 1
' Проверка выхода за максимальное количество триад
If n > MAX3 Then Exit Function
Loop Until Value <= 0
If Sign = "ноль " Then
Sign = ""
S = ""
ElseIf S = "рублей " Then
S = ""
End If
S = Sign + S + K
Прописью = UCase(Mid(S, 1, 1)) + Mid(S, 2)
End Function
Удачи!
Похожие вопросы
- Перечень допустимых функций в SQL-запросе ADO Jet 4.0 (MS Access)
- OpenProcess ошибка Access is denied. в windows 7 Visual C++ 2008
- Вставка "вложенной" таблицы в Excel (или Access)
- Проблема в программе Access, хочу сделать подарок папе, помогите, пожалуйста
- Помогите с базой данных Delphi+Access
- [SQL-Access] Как вычесть текущую запись поля из предыдущего?
- SQL и PHP. Access denied for user 'u3464476869_vid'@'12.3.4.23' to database 'u3464476869_Hyp'
- возможно настроить в visual basic 6.0 поддержку access 2003 ??
- как зашить в exe шник VB 6.0 файлы access или excel (чтобы компилировался только один файл)?
- Где скачать Access??? помогите!!!