Vba excel рубль рубля рублей - Word и Excel - помощь в работе с программами

Код пользовательской функции VBA Excel для преобразования денежного значения из числовой формы в сумму прописью. До 12 целочисленных разрядов включительно.

С помощью данной функции денежные значения преобразуются в текст следующего формата: 0,00 = Ноль рублей 00 копеек.

Public Function СуммаПрописью(x As Double) As String

If x > 999999999999.99 Then

СуммаПрописью = «Аргумент больше 999 999 999 999.99!»

ElseIf x < 0 Then

СуммаПрописью = «Аргумент отрицательный!»

Else

x = FormatNumber(x, 2)

Dim b As Byte, b1 As Byte, b2 As Byte, kop As String

b = (x — Fix(x)) * 100

b2 = b 10

b1 = b Mod 10

If b2 <> 1 And b1 = 1 Then

kop = » копейка»

ElseIf b2 <> 1 And b1 > 1 And b1 < 5 Then

kop = » копейки»

Else

kop = » копеек»

End If

kop = b2 & b1 & kop

Dim y(1 To 4) As Integer, i1 As Byte

For i1 = 1 To 4

x = Fix(x) / 1000

y(i1) = (x — Fix(x)) * 1000

Dim Text(1 To 4) As String, i2 As Byte, y1 As Byte, y2 As Byte, _

y3 As Byte, Text0 As String, Text1 As String, Text2 As String, Text3 As String, _

Text4 As String

For i2 = 1 To 4

y1 = y(i2) Mod 10

y2 = (y(i2) — y1) / 10 Mod 10

y3 = y(i2) 100

Text1 = Choose(y3 + 1, «», «сто «, «двести «, «триста «, «четыреста «, _

«пятьсот «, «шестьсот «, «семьсот «, «восемьсот «, «девятьсот «)

Text2 = Choose(y2 + 1, «», «», «двадцать «, «тридцать «, «сорок «, _

«пятьдесят «, «шестьдесят «, «семьдесят «, «восемьдесят «, «девяносто «)

If y2 = 1 Then

Text3 = Choose(y1 + 1, «десять «, «одиннадцать «, «двенадцать «, _

«тринадцать «, «четырнадцать «, «пятнадцать «, «шестнадцать «, _

«семнадцать «, «восемнадцать «, «девятнадцать «)

ElseIf y2 <> 1 And i2 = 2 Then

Text3 = Choose(y1 + 1, «», «одна «, «две «, «три «, «четыре «, «пять «, _

«шесть «, «семь «, «восемь «, «девять «)

Else

Text3 = Choose(y1 + 1, «», «один «, «два «, «три «, «четыре «, «пять «, _

«шесть «, «семь «, «восемь «, «девять «)

End If

If y2 <> 1 And y1 = 1 Then

Text4 = Choose(i2, «рубль «, «тысяча «, «миллион «, «миллиард «)

ElseIf y2 <> 1 And y1 > 1 And y1 < 5 Then

Text4 = Choose(i2, «рубля «, «тысячи «, «миллиона «, «миллиарда «)

ElseIf y1 = 0 And y2 = 0 And y3 = 0 Then

Text4 = Choose(i2, «рублей «, «», «», «»)

Else

Text4 = Choose(i2, «рублей «, «тысяч «, «миллионов «, «миллиардов «)

End If

Text(i2) = Text1 & Text2 & Text3 & Text4

If y(1) + y(2) + y(3) + y(4) = 0 Then

Text0 = «ноль рублей « & kop

Else

Text0 = Text(4) & Text(3) & Text(2) & Text(1) & kop

End If

СуммаПрописью = Replace(Text0, Left(Text0, 1), UCase(Left(Text0, 1)), 1, 1)

End If

End Function

Кроме данной функции на рабочем листе Excel, не прибегая к VBA, можно использовать блок ячеек с формулами для возврата суммы прописью. Например, в бланках различных документов, которые отдельными файлами передаются на компьютеры других пользователей.

Источник

Добрый день.
Есть небольшая процедурка которая в зависимости от выбраной валюты, устанавливает формат ячеек.
Но блин две проблемы.
1. Не могу почему то в VBA поставить символ рубля, выводится вопросительный знак ?
2. Не могу найти ошибку в формате Евро, вроде бы все правильно написано, а перестала работать

Хелп
Вот процедурка

Sub ReplaceFormats()
Application.FindFormat.Clear
Application.ReplaceFormat.Clear
NumFormat = Worksheets(«DD»).Range(«D14»).NumberFormat
OldFormat = Worksheets(«DD»).Range(«D14»).NumberFormat

If Worksheets(«DD»).Range(«I1»).Value = «EUR» Then
NumFormat = «[$ˆ-409]#,##0_;-[$ˆ-409]#,##0″
End If

If Worksheets(«DD»).Range(«I1»).Value = «USD» Then
NumFormat = «[$$-409]#,##0_ ;-[$$-409]#,##0 «
End If

If Worksheets(«DD»).Range(«i1»).Value = «RUB» Then
NumFormat = «#,##0 [$?-419];-#,##0 [$?-419]»
End If

‘ set formatting to look for
With Application.FindFormat
.NumberFormat = OldFormat
End With
‘ set formatting that should be applied instead
With Application.ReplaceFormat
‘ .Font.Bold = False
.NumberFormat = NumFormat
‘ .Font.Size = 8
End With
ActiveSheet.Cells.Replace What:=»», Replacement:=»», _
SearchFormat:=True, ReplaceFormat:=True

End Sub
‘Dim oRange As Range

Источник

Часто нужно перевести число в текст в Excel так, чтобы оно отображалось прописью (словами) на русском или других языках. Так как по умолчанию нет готовой функции, создадим свою пользовательскую функцию с помощью макросов.

Пример использования пользовательской функции для преобразования числа суммы в текстовые слова, которую можно скачать в конце статьи:

Для создания пользовательской функции, которая сможет перевести число в текст прописью , нам нужно выполнить 3 простых шага:

Открыть редактор макросов ALT+F11.
Создать новый модуль и в нем нужно написать функцию особенным способом: Function вместо Sub. Тогда наша функция «ЧислоПропись» будет отображаться в списке мастера функций (SHIFT+F3), в категории «Определенные пользователем».

Module.

Вставить в модуль следующий код и сохранить:

Function ЧислоПропись(Число As Currency) As String
‘до 999 999 999 999
On Error GoTo Число_Error
Dim strМиллиарды As String, strМиллионы As String, strТысячи As String, strЕдиницы As String, strСотые As String
Dim Поз As Integer

strЧисло = Format(Int(Число),

«000000000000»)

‘Миллиарды’
Поз = 1
strМиллиарды = Сотни(Mid(strЧисло, Поз, 1))
strМиллиарды = strМиллиарды & Десятки(Mid(strЧисло, Поз + 1, 2), «м»)
strМиллиарды = strМиллиарды & ИмяРазряда(strМиллиарды, Mid(strЧисло, Поз + 1, 2), «миллиард «, «миллиарда «, «миллиардов «)

‘Миллионы’
Поз = 4
strМиллионы = Сотни(Mid(strЧисло, Поз, 1))
strМиллионы = strМиллионы & Десятки(Mid(strЧисло, Поз + 1, 2), «м»)
strМиллионы = strМиллионы & ИмяРазряда(strМиллионы, Mid(strЧисло, Поз + 1, 2), «миллион «, «миллиона «, «миллионов «)

‘Тысячи’
Поз = 7
strТысячи = Сотни(Mid(strЧисло, Поз, 1))
strТысячи = strТысячи & Десятки(Mid(strЧисло, Поз + 1, 2), «ж»)
strТысячи = strТысячи & ИмяРазряда(strТысячи, Mid(strЧисло, Поз + 1, 2), «тысяча «, «тысячи «, «тысяч «)

‘Единицы’
Поз = 10
strЕдиницы = Сотни(Mid(strЧисло, Поз, 1))
strЕдиницы = strЕдиницы & Десятки(Mid(strЧисло, Поз + 1, 2), «м»)
If strМиллиарды & strМиллионы & strТысячи & strЕдиницы = «» Then strЕдиницы = «ноль «
‘strЕдиницы = strЕдиницы & ИмяРазряда(» «, Mid(strЧисло, Поз + 1, 2), «рубль «, «рубля «, «рублей «)

‘Сотые’
‘strСотые = strКопейки & » » & ИмяРазряда(strКопейки, Right(strКопейки, 2), ‘»копейка», «копейки», «копеек»)

ЧислоПропись = strМиллиарды & strМиллионы & strТысячи & strЕдиницы
ЧислоПропись = UCase(Left(ЧислоПропись, 1)) & Right(ЧислоПропись, Len(ЧислоПропись) — 1)

Exit Function

Число_Error:
MsgBox Err.Description

End Function

Function Сотни(n As String) As String
Сотни = «»
Select Case n
    Case 0: Сотни = «»
    Case 1: Сотни = «сто «
    Case 2: Сотни = «двести «
    Case 3: Сотни = «триста «
    Case 4: Сотни = «четыреста «
    Case 5: Сотни = «пятьсот «
    Case 6: Сотни = «шестьсот «
    Case 7: Сотни = «семьсот «
    Case 8: Сотни = «восемьсот «
    Case 9: Сотни = «девятьсот «
End Select
End Function

Function Десятки(n As String, Sex As String) As String
Десятки = «»
Select Case Left(n, 1)
    Case «0»: Десятки = «»: n = Right(n, 1)
    Case «1»: Десятки = «»
    Case «2»: Десятки = «двадцать «: n = Right(n, 1)
    Case «3»: Десятки = «тридцать «: n = Right(n, 1)
    Case «4»: Десятки = «сорок «: n = Right(n, 1)
    Case «5»: Десятки = «пятьдесят «: n = Right(n, 1)
    Case «6»: Десятки = «шестьдесят «: n = Right(n, 1)
    Case «7»: Десятки = «семьдесят «: n = Right(n, 1)
    Case «8»: Десятки = «восемьдесят «: n = Right(n, 1)
    Case «9»: Десятки = «девяносто «: n = Right(n, 1)
End Select

Dim Двадцатка As String
Двадцатка = «»
Select Case n
    Case «0»: Двадцатка = «»
    Case «1»
        Select Case Sex
            Case «м»: Двадцатка = «один «
            Case «ж»: Двадцатка = «одна «
            Case «с»: Двадцатка = «одно «
        End Select
    Case «2»:
        Select Case Sex
            Case «м»: Двадцатка = «два «
            Case «ж»: Двадцатка = «две «
            Case «с»: Двадцатка = «два «
        End Select
    Case «3»: Двадцатка = «три «
    Case «4»: Двадцатка = «четыре «
    Case «5»: Двадцатка = «пять «
    Case «6»: Двадцатка = «шесть «
    Case «7»: Двадцатка = «семь «
    Case «8»: Двадцатка = «восемь «
    Case «9»: Двадцатка = «девять «
    Case «10»: Двадцатка = «десять «
    Case «11»: Двадцатка = «одиннадцать «
    Case «12»: Двадцатка = «двенадцать «
    Case «13»: Двадцатка = «тринадцать «
    Case «14»: Двадцатка = «четырнадцать «
    Case «15»: Двадцатка = «пятнадцать «
    Case «16»: Двадцатка = «шестнадцать «
    Case «17»: Двадцатка = «семнадцать «
    Case «18»: Двадцатка = «восемнадцать «
    Case «19»: Двадцатка = «девятнадцать «
End Select

Десятки = Десятки & Двадцатка

End Function

Function ИмяРазряда(Строка As String, n As String, Имя1 As String, Имя24 As String, ИмяПроч As String) As String

If Строка <> «» Then
    ИмяРазряда = «»
    Select Case Left(n, 1)
        Case «0», «2», «3», «4», «5», «6», «7», «8», «9»: n = Right(n, 1)
    End Select

Select Case n
        Case «1»: ИмяРазряда = Имя1
        Case «2», «3», «4»: ИмяРазряда = Имя24
        Case Else: ИмяРазряда = ИмяПроч
    End Select
End If

End Function

Можно написать алгоритм макро программы по-другому и еще сделать так, чтобы она дописывала валюту суммы прописью. Для этого создайте Module2 и введите в него следующий код:

Function ЧислоПрописьюВалюта(Число As Double, Optional Валюта As Integer = 1, Optional Копейки As Integer = 1)
Attribute ЧислоПрописьюВалюта.VB_Description = «Функция преобразовывает число суммы текстовыми словами»
Attribute ЧислоПрописьюВалюта.VB_ProcData.VB_Invoke_Func = » n1″
Dim Edinicy(0 To 19) As String: Dim EdinicyPoslednie(0 To 19) As String
Dim Desyatki(0 To 9) As String: Dim Sotni(0 To 9) As String: Dim mlrd(0 To 9) As String
Dim mln(0 To 9) As String: Dim tys(0 To 9) As String
Dim SumInt, x, shag, vl As Integer: Dim txt, Sclon_Tys As String
‘———————————————
Application.Volatile
‘———————————————
Edinicy(0) = «»: EdinicyPoslednie(0) = IIf(Валюта = 0, «евро», IIf(Валюта = 1, «рублей», «долларов»))
Edinicy(1) = «один «: EdinicyPoslednie(1) = IIf(Валюта = 0, «один евро», IIf(Валюта = 1, «один рубль», «один доллар»))
Edinicy(2) = «два «: EdinicyPoslednie(2) = IIf(Валюта = 0, «два евро», IIf(Валюта = 1, «два рубля», «два доллара»))
Edinicy(3) = «три «: EdinicyPoslednie(3) = IIf(Валюта = 0, «три евро», IIf(Валюта = 1, «три рубля», «три доллара»))
Edinicy(4) = «четыре «: EdinicyPoslednie(4) = IIf(Валюта = 0, «четыре евро», IIf(Валюта = 1, «четыре рубля», «четыре доллара»))
Edinicy(5) = «пять «: EdinicyPoslednie(5) = IIf(Валюта = 0, «пять евро», IIf(Валюта = 1, «пять рублей», «пять долларов»))
Edinicy(6) = «шесть «: EdinicyPoslednie(6) = IIf(Валюта = 0, «шесть евро», IIf(Валюта = 1, «шесть рублей», «шесть долларов»))
Edinicy(7) = «семь «: EdinicyPoslednie(7) = IIf(Валюта = 0, «семь евро», IIf(Валюта = 1, «семь рублей», «семь долларов»))
Edinicy(8) = «восемь «: EdinicyPoslednie(8) = IIf(Валюта = 0, «восемь евро», IIf(Валюта = 1, «восемь рублей», «восемь долларов»))
Edinicy(9) = «девять «: EdinicyPoslednie(9) = IIf(Валюта = 0, «девять евро», IIf(Валюта = 1, «девять рублей», «девять долларов»))
Edinicy(11) = «одиннадцать «: EdinicyPoslednie(11) = IIf(Валюта = 0, «одиннадцать евро», IIf(Валюта = 1, «одиннадцать рублей», «одиннадцать долларов»))
Edinicy(12) = «надцать «: EdinicyPoslednie(12) = IIf(Валюта = 0, «надцать евро», IIf(Валюта = 1, «надцать рублей», «надцать долларов»))
Edinicy(13) = «тринадцать «: EdinicyPoslednie(13) = IIf(Валюта = 0, «тринадцать евро», IIf(Валюта = 1, «тринадцать рублей», «тринадцать долларов»))
Edinicy(14) = «четырнадцать «: EdinicyPoslednie(14) = IIf(Валюта = 0, «четырнадцать евро», IIf(Валюта = 1, «четырнадцать рублей», «четырнадцать долларов»))
Edinicy(15) = «пятнадцать «: EdinicyPoslednie(15) = IIf(Валюта = 0, «пятнадцать евро», IIf(Валюта = 1, «пятнадцать рублей», «пятнадцать долларов»))
Edinicy(16) = «шестнадцать «: EdinicyPoslednie(16) = IIf(Валюта = 0, «шестнадцать евро», IIf(Валюта = 1, «шестнадцать рублей», «шестнадцать долларов»))
Edinicy(17) = «семнадцать «: EdinicyPoslednie(17) = IIf(Валюта = 0, «семнадцать евро», IIf(Валюта = 1, «семнадцать рублей», «семнадцать долларов»))
Edinicy(18) = «восемнадцать «: EdinicyPoslednie(18) = IIf(Валюта = 0, «восемнадцать евро», IIf(Валюта = 1, «восемнадцать рублей», «восемнадцать долларов»))
Edinicy(19) = «девятнадцать «: EdinicyPoslednie(19) = IIf(Валюта = 0, «девятнадцать евро», IIf(Валюта = 1, «девятнадцать рублей», «девятнадцать долларов»))
»———————————————
Desyatki(0) = «»: Sotni(0) = «»: tys(0) = «тисячь «: mln(0) = «миллионов «: mlrd(0) = «миллиардов «
Desyatki(1) = «десять «: Sotni(1) = «сто «: tys(1) = «тысяча «: mln(1) = «миллион «: mlrd(1) = «миллиарда «
Desyatki(2) = «двадцать «: Sotni(2) = «двести «: tys(2) = «тысячи «: mln(2) = «миллиона «: mlrd(2) = «миллиарда «
Desyatki(3) = «тридцать «: Sotni(3) = «триста «: tys(3) = «тысячи «: mln(3) = «миллиона «: mlrd(3) = «миллиарда «
Desyatki(4) = «сорок «: Sotni(4) = «четыреста «: tys(4) = «тысячи «: mln(4) = «миллиона «: mlrd(4) = «миллиарда «
Desyatki(5) = «пятьдесят «: Sotni(5) = «пятьсот «: tys(5) = «тысяч «: mln(5) = «миллионов «: mlrd(5) = «миллиардов «
Desyatki(6) = «шестьдесят «: Sotni(6) = «шестьсот «: tys(6) = «тысяч «: mln(6) = «миллионов «: mlrd(6) = «миллиардов «
Desyatki(7) = «семьдесят «: Sotni(7) = «семьсот «: tys(7) = «тысяч «: mln(7) = «миллионов «: mlrd(7) = «миллиардов «
Desyatki(8) = «восемьдесят «: Sotni(8) = «восемьсот «: tys(8) = «тысяч «: mln(8) = «миллионов «: mlrd(8) = «миллиардов «
Desyatki(9) = «девяносто «: Sotni(9) = «девятьсот «: tys(9) = «тысяч «: mln(9) = «миллионов «: mlrd(9) = «миллиардов «
‘———————————————

On Error Resume Next
SumInt = Int(Число)
For x = Len(SumInt) To 1 Step -1
    shag = shag + 1
    Select Case x
        Case 12 ‘ — сотни миллиардов
            vl = Mid(SumInt, shag, 1)
            txt = txt & Sotni(vl)
        Case 11 ‘ — десятки  миллиардов
            vl = Mid(SumInt, shag, 1)
            If vl = «1» And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo 10 Else txt = txt & Desyatki(vl)  ‘ — если конец триады от 11 до 19 то перескакиваем на единицы, иначе — формируем десятки
        Case 10 ‘ — единицы  миллиардов
            vl = Mid(SumInt, shag, 1)
            If shag > 1 Then
                If Mid(SumInt, shag — 1, 1) = 1 Then txt = txt & Edinicy(Mid(SumInt, shag — 1, 2)) & «миллиарда « Else txt = txt & Edinicy(vl) & mlrd(vl) ‘числа в диапозоне от 11 до 19 склоняются на «мільярдов» независимо от последнего числа триады
            Else
                txt = txt & Edinicy(vl) & mlrd(vl)
            End If

‘-КОНЕЦ БЛОКА_______________________

Case 9 ‘ — сотни миллионов
            vl = Mid(SumInt, shag, 1)
            txt = txt & Sotni(vl)
        Case 8 ‘ — десятки  миллионов
            vl = Mid(SumInt, shag, 1)
            If vl = «1» And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo 10 Else txt = txt & Desyatki(vl)  ‘ — если конец триады от 11 до 19 то перескакиваем на единицы, иначе — формируем десятки
        Case 7 ‘ — единицы  миллионов
            vl = Mid(SumInt, shag, 1)
            If shag > 2 Then
                If (Mid(SumInt, shag — 2, 1) = 0 And Mid(SumInt, shag — 1, 1) = 0 And vl = «0») Then GoTo 10
            End If
            If shag > 1 Then
                If Mid(SumInt, shag — 1, 1) = 1 Then txt = txt & Edinicy(Mid(SumInt, shag — 1, 2)) & «миллиона « Else: txt = txt & Edinicy(vl) & mln(vl)  ‘числа в диапозоне от 11 до 19 склоняются на «миллиардов» независимо от последнего числа триады
            Else
                txt = txt & Edinicy(vl) & mln(vl)
            End If
        ‘-КОНЕЦ БЛОКА_______________________

Case 6 ‘ — сотни тысяч
            vl = Mid(SumInt, shag, 1)
            txt = txt & Sotni(vl)
        Case 5 ‘ — десятки  тысяч
            vl = Mid(SumInt, shag, 1)
            If vl = 1 And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo 10 Else txt = txt & Desyatki(vl)  ‘ — если конец триады от 11 до 19 то перескакиваем на единицы, иначе — формируем десятки
        Case 4 ‘ — единицы  тысяч
            vl = Mid(SumInt, shag, 1)
            If shag > 2 Then
                If (Mid(SumInt, shag — 2, 1) = 0 And Mid(SumInt, shag — 1, 1) = 0 And vl = «0») Then GoTo 10
            End If
            Sclon_Tys = Edinicy(vl) & tys(vl) ‘ — вводим переменную Sclon_Tys из-за иного склонения  тысяч в русском языке
            If vl = 1 Then Sclon_Tys = «одна « & tys(vl) ‘ — для тысяч склонение «один» и «два» неприменимо ( поэтому вводим переменную  Sclon_Tys )
            If vl = 2 Then Sclon_Tys = «две « & tys(vl) ‘ — для тысяч склонение «один» и «два» неприменимо ( поэтому вводим переменную  Sclon_Tys )
            If shag > 1 Then
                If Mid(SumInt, shag — 1, 1) = 1 Then Sclon_Tys = Edinicy(Mid(SumInt, shag — 1, 2)) & «тисяч «
            End If
            txt = txt & Sclon_Tys

‘-КОНЕЦ БЛОКА_______________________
        Case 3 ‘ — сотни
            vl = Mid(SumInt, shag, 1)
            txt = txt & Sotni(vl)
        Case 2 ‘ — десятки
            vl = Mid(SumInt, shag, 1)
            If vl = «1» And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo 10 Else txt = txt & Desyatki(vl)  ‘ — если конец триады от 11 до 19 то перескакиваем на единицы, иначе — формируем десятки
        Case 1 ‘ — единицы
            If Mid(SumInt, shag — 1, 1) <> 1 Or Mid(SumInt, shag — 1, 2) = «10» Then vl = Mid(SumInt, shag, 1) Else vl = Mid(SumInt, shag — 1, 2)
                txt = txt & EdinicyPoslednie(vl)

‘-КОНЕЦ БЛОКА_______________________

End Select
10: Next x
a = Число
b = Int(a)
c = (Round(a — b, 2)) * 100
If c < 10 And c >= 1 Then c = «0» + CStr(c)
If c = 0 Then c = CStr(c) + «0»
d = «»
If Валюта = 1 Then d = «коп.» Else d = «цен.»
If Валюта > 2 Or Валюта < 0 Then MsgBox «Укажите параметр 0-2»
If Валюта > 2 Or Валюта < 0 Then GoTo 11
If Копейки = 0 Then
d = «»
c = «»
End If
If Копейки = 2 Then d = «»
If Копейки > 2 Or Копейи < 0 Then MsgBox «Укажите параметр 0, 1 или 2»
If Копейки > 2 Or Копейки < 0 Then GoTo 11
ЧислоПрописьюВалюта = UCase(Left(txt, 1)) & LCase(Mid(txt, 2)) + » « + CStr(c) + d
11:
End Function

Sub DescribeFunction()
   Dim FuncName As String
   Dim FuncDesc As String
   Dim Category As String
   Dim ArgDesc(1 To 3) As String

FuncName =

«ЧислоПрописьюВалюта»
   FuncDesc = «Функция преобразовывает число суммы текстовыми словами»
   Category = 1 ‘Text category
   ArgDesc(1) = «Исходная сумма»
   ArgDesc(2) = «(необязательный) Тип отображаемой валюты 0-Евро, 1-Рубли, 2-Доллары.»
   ArgDesc(3) = «(необязательный) Нужны ли копейки: 0-нет, 1-отображать копейи стандартно, 2-отображать только дробную часть (без слов).»

   Application.MacroOptions _
      Macro:=FuncName, _
      Description:=FuncDesc, _
      Category:=Category, _
      ArgumentDescriptions:=ArgDesc

End Sub

Также не забудьте добавить в рабочую книгу код вызова макроса регистрации DescribeFunction, чтобы отображать описание атрибутов для пользовательской функции:

Private Sub Workbook_Open()
DescribeFunction
End Sub

Кроме того благодаря данному макросу DescribeFunction функция будет доступна в группе: «ФОРМУЛЫ»-«Библиотека функций»-«Финансовые»-«ЧислоПрописьюВалюта»

Если мы указываем число (от 0 до 2)в параметре второй функции «ЧислоПрописьюВалюта» то функция автоматически подставит нужную валюту в сумме прописью:

1-рубли;
2-доллары;
0-евро;

Как видите, этот VBA-код макроса преобразует числа в слова. После вставки данного кода в модуль редактора макросов, у нас работает новая функция, которую можно вызвать из мастера (кнопка fx возле строки формул).

Скачать число прописью в Excel руб RUB.

Украинская версия функции ЧислоСловоВалюта для перевода сумм в гривны находиться в следующем файле:

Скачать функцию ЧислоСловоВалюта ГРН UAH

Теперь вы можете быстро перевести сумму в слова прописью. Чтобы воспользоваться готовым решением рекомендуем скачать пример числа прописью в Excel. Данный файл содержит уже готовую пользовательскую функцию и VBA-код макроса, который доступен в модуле из редактора.

Источник

Данный код (пользовательская функция) позволяет получить данные о курсе валюты с сайта Центробанка.

Данную функцию можно использовать и в виде формулы на листе Excel (см. пример во вложении)

Function GetRate(ByVal CurrencyName As String, ByVal RateDate As Date) As Double
    ' функция возвращает курс валюты CurrencyName на дату RateDate
    ' в случае ошибки (неверная дата или название валюты) возвращается 0
    On Error Resume Next
    CurrencyName = UCase(CurrencyName): If Len(CurrencyName) <> 3 Then Exit Function
    Set xmldoc = CreateObject("Msxml.DOMDocument"): xmldoc.async = False
    url_request = "http://www.cbr.ru/scripts/XML_daily.asp?date_req=" + Format(RateDate, "dd/mm/yyyy")
 
    If xmldoc.Load(url_request) <> True Then Exit Function    ' Запрос к серверу ЦБР

    ' Обработка полученного ответа
    Set nodeList = xmldoc.selectNodes("ValCurs"): Set xmlNode = nodeList.Item(0).CloneNode(True)
    Set node_attr = xmlNode.Attributes(0): strDate = node_attr.Value
    Set nodeList = xmldoc.selectNodes("*/Valute")
    For i = 0 To nodeList.Length - 1    ' поиск нужной валюты
        Set xmlNode = nodeList.Item(i).CloneNode(True)
        If xmlNode.childNodes(1).Text = CurrencyName Then
            CurrencyRate = CDbl(xmlNode.childNodes(4).Text)
            divisor = Val(xmlNode.childNodes(2).Text)
            GetRate = CurrencyRate / divisor
            Exit Function
        End If
    Next
End Function

Sub ПримерИспользованияФункции_GetRate()
    MsgBox "Сегодня курс доллара к рублю составил " & GetRate("USD", Now), vbInformation
    MsgBox "А вчера курс евро к рублю был равен " & GetRate("EUR", Now - 1), vbInformation
End Sub

Поддерживается получение курсов рубля по отношению к следующим валютам:

AUD Австралийский доллар
AZN Азербайджанский манат
GBP Фунт стерлингов Соединенного королевства
AMD Армянский драм
BYR Белорусский рубль
BGN Болгарский лев
BRL Бразильский реал
HUF Венгерский форинт
DKK Датская крона
USD Доллар США
EUR Евро
INR Индийская рупия
KZT Казахский тенге
CAD Канадский доллар
KGS Киргизский сом
CNY Китайский юань
LVL Латвийский лат
LTL Литовский лит
MDL Молдавский лей
NOK Норвежская крона
PLN Польский злотый
RON Новый румынский лей
XDR СДР (специальные права заимствования)
SGD Сингапурский доллар
TJS Таджикский сомони
TRY Турецкая лира
TMT Новый туркменский манат
UZS Узбекский сум
UAH Украинская гривна
CZK Чешская крона
SEK Шведская крона
CHF Швейцарский франк
EEK Эстонская крона
ZAR Южноафриканский рэнд
KRW Вон Республики Корея
JPY Японская иена

Если вы желаете вывести информацию по всем валютам — используйте макрос ВывестиСегодняшниеКурсыВсехВалют:

Sub ВывестиСегодняшниеКурсыВсехВалют()
    On Error Resume Next
    Set xmldoc = CreateObject("Msxml.DOMDocument"): xmldoc.async = False
    url_request = "http://www.cbr.ru/scripts/XML_daily.asp?date_req=" + Format(Now, "dd/mm/yyyy")
    If xmldoc.Load(url_request) <> True Then Exit Sub
    Set nodeList = xmldoc.selectNodes("ValCurs"): Set xmlNode = nodeList.Item(0).CloneNode(True)
    Set node_attr = xmlNode.Attributes(0): strDate = node_attr.Value
    Set nodeList = xmldoc.selectNodes("*/Valute")
    For i = 0 To nodeList.Length - 1
        Set xmlNode = nodeList.Item(i).CloneNode(True)
        Debug.Print "Курс " & xmlNode.childNodes(1).Text & " (установлен " & strDate & "): " & _
                    xmlNode.childNodes(4).Text & " рублей за " & xmlNode.childNodes(2).Text & _
                  " " & xmlNode.childNodes(3).Text
    Next
End Sub

Результат работы макроса ВывестиСегодняшниеКурсыВсехВалют:

Курс AUD (установлен 28/07/2010): 27,2968 рублей за 1 Австралийский доллар
Курс AZN (установлен 28/07/2010): 37,6342 рублей за 1 Азербайджанский манат
Курс BRL (установлен 28/07/2010): 17,1589 рублей за 1 Бразильский реал
…
Курс HUF (установлен 28/07/2010): 13,7407 рублей за 100 Венгерских форинтов
Курс DKK (установлен 28/07/2010): 52,7135 рублей за 10 Датских крон
Курс USD (установлен 28/07/2010): 30,2391 рублей за 1 Доллар США
Курс EUR (установлен 28/07/2010): 39,3139 рублей за 1 Евро
…
Курс CHF (установлен 28/07/2010): 28,6953 рублей за 1 Швейцарский франк
Курс EEK (установлен 28/07/2010): 25,1057 рублей за 10 Эстонских крон
Курс ZAR (установлен 28/07/2010): 41,1383 рублей за 10 Южноафриканских рэндов
Курс KRW (установлен 28/07/2010): 25,6003 рублей за 1000 Вон Республики Корея

Источник

Анжелика Пользователь Сообщений: 274 Регистрация: 25.06.2015	Добрый вечер! Как в ексель в денежном формате установить вместо квадратика значение р. или руб. как это было раньше? Изменено: Анжелика — 18.12.2017 23:19:00 (Пример)

	извините, где тут подвох? а в чем сложность-то? Прикрепленные файлы 1р.xlsx (7.46 КБ) Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

	Анжелика, приложите пример. А так: правая кнопка мыши — формат ячейки — денежный — выбираете/настраиваете хоть рубли, хоть тугрики.

Юрий М

Модератор

Сообщений: 60575
Регистрация: 14.09.2012

Контакты см. в профиле

18.12.2017 23:21:35

Цитата
Анжелика написал: установить вместо квадратика

А про какой «квадратик» разговор? Есть подозрение, что этот квадратик отображается вместо символа рубля ) Почитайте здесь.

Анжелика Пользователь Сообщений: 274 Регистрация: 25.06.2015

Hugo

Пользователь

Сообщений: 23251
Регистрация: 22.12.2012

18.12.2017 23:24:30

Я открыл первый файл — рубли на месте. Т.е. конечно не рубли, а символ рубля, и формат выбран

Код
# ##0 "₽";-# ##0 "₽"

Может что-то с фонтами, если не показывает?

БМВ

Модератор

Сообщений: 21378
Регистрация: 28.12.2016

Excel 2013, 2016

18.12.2017 23:25:22

Цитата
Анжелика написал: вместо квадратика

Вот у сменя с этим проблема, где взять квадратики?

Анжелика, у вас скорее со шрифтами проблема, а не с форматом символ валюты принятый «недавно» для рубля, ₽ . вот квадратом и русует.

Изменено: БМВ — 18.12.2017 23:32:46

По вопросам из тем форума, личку не читаю.

vikttur Пользователь Сообщений: 47199 Регистрация: 15.09.2012	Бедные вы на форматы… Это формат Анжелика, Выберите Денежный, обзначние «р.»

Анжелика Пользователь Сообщений: 274 Регистрация: 25.06.2015	БМВ, это можно как-то исправить самостоятельно — мне без них плохо! все время приходиться сцеплять с руб.

Hugo Пользователь Сообщений: 23251 Регистрация: 22.12.2012	vikttur, а я на формат богаче, у меня символ есть Может его с форума можно скопировать туда вместо квадрата?

Анжелика Пользователь Сообщений: 274 Регистрация: 25.06.2015	vikttur, да наверное у меня что-то сломалось такого формата почему-то нет

Kuzmich

Пользователь

Сообщений: 7998
Регистрация: 21.12.2012

#12

18.12.2017 23:39:47

В формате ячейки заменил квадратик на р

Код
# ##0 "₽";-# ##0 "₽"

ZVI

Пользователь

Сообщений: 4328
Регистрация: 23.12.2012

Это проблема из-за того, что на данном компьютере используются старые шрифты, а ячейки были отформатированы на компьютере с обновленными шрифтакми, в которых есть международный символ рубля. Выделите ячейки, в которых нужно исправить формат, на выделенном — правый клик — формат ячеек — денежный — число десятичных знаков выставить равным нулю, а обозначении выбрать р., выбрать для отрицательных чисел вариант с красным шрифтом -1 234р. и нажать OK.

Изменено: ZVI — 18.12.2017 23:47:05

БМВ

Модератор

Сообщений: 21378
Регистрация: 28.12.2016

Excel 2013, 2016

для начала попробуйте просто поменять шрифт, на отличны от того что есть сейчас. Если не помогает то попробуйте просто вставить этот символ в экселе или в ворде. Это можно сделать через меню вставить символ, alt+n+u nfd можно будет ввести код 20BD.
А далее по результату надо судить.

По вопросам из тем форума, личку не читаю.

vikttur

Пользователь

Сообщений: 47199
Регистрация: 15.09.2012

#15

18.12.2017 23:46:01

Цитата
Анжелика написал: такого формата почему-то нет

Денежный у Вас есть. Поднимите глазки Выше по списку в Вашей картинке )

БМВ

Модератор

Сообщений: 21378
Регистрация: 28.12.2016

Excel 2013, 2016

#16

18.12.2017 23:53:36

Цитата
ZVI написал: Это проблема из-за того, что на данном компьютере используются старые шрифты

Просто интересно, какую надо иметь систему, с такими стандартными шрифтами , или XP или необновленную висту, 7ку. или 8ку первого выпуска . сивол в конце 13 го ввели.

Изменено: БМВ — 19.12.2017 00:00:30

По вопросам из тем форума, личку не читаю.

Анжелика Пользователь Сообщений: 274 Регистрация: 25.06.2015	vikttur, БМВ, у меня 7ка и 10 excel

ZVI

Пользователь

Сообщений: 4328
Регистрация: 23.12.2012

#18

19.12.2017 00:05:07

Цитата
БМВ написал: Просто интересно, какую надо иметь систему

У меня квадратики на одной из операционных систем — XP SP3. не обновлялась несколько лет

Анжелика Пользователь Сообщений: 274 Регистрация: 25.06.2015	БМВ, vikttur, ZVI, Спасибо, за подсказки вызову мастера пусть шрифты проверит, может что удалила, я тот еще пользователь!

ZVI

Пользователь

Сообщений: 4328
Регистрация: 23.12.2012

#20

19.12.2017 00:09:39

Цитата
Анжелика написал: у меня 7ка и 10 excel

Анжелика тогда выделите эти ячейки — правый клик — формат ячеек — (все форматы) — в поле Тип вместо квадратиков впишите р. и нажмите OK

Ігор Гончаренко

Пользователь

Сообщений: 13746
Регистрация: 01.01.1970

#21

19.12.2017 00:30:36

Цитата
вызову мастера пусть шрифты проверит

скажите мастеру, пусть возьмет с собой по-больше букв Р
у меня однажды в принтере закончились буквы Л и он их не печатал, оставлял пропуски

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

vikttur

Пользователь

Сообщений: 47199
Регистрация: 15.09.2012

#22

19.12.2017 00:43:28

Цитата
Ігор Гончаренко написал: пусть возьмет с собой по-больше букв Р

… а взамен отвалите мастеру тех комплектов знаков, что стоят левее буквы «р»

Hugo Пользователь Сообщений: 23251 Регистрация: 22.12.2012	#23 19.12.2017 09:13:41 Главное не перепутать р с p

Источник