Сумма прописью в MS Excel

Для автоматической вставки суммы прописью в MS Excel необходимо добавить макрос (1. Num2String.bas, 2. summa_propis_ Excel.bas – вариант с украинской гривной)

В MS Excel 2013

Меню РАЗРАБОТЧИК – Visual Basic – File – Import File… – Num2String.bas

В документе в ячейку MS Excel вставить: 1. =Num2Str(Y1;1;0;0)  2.=СуммаПрописью(D6)

Y1 или D6 – Ваша ячейка с суммой цифрами.

 

Примеры: 1. файла MS Excel, 2. АВАНСОВЫЙ ОТЧЕТ

 

Текст макроса Num2String.bas

Attribute VB_Name = “Num2String”
‘Данный модуль содержит программу преобразования числа в текстовое представление
‘Copyright (c) 1998 Igor Ulyanchenko
‘e-mail: igorul@aha.ru

Option Explicit
Const sSpace As String = ” ”
Const sOne As Byte = 1
Const sMany1 As Byte = 2
Const sMany2 As Byte = 3
Const Male As Byte = 1
Const Female As Byte = 0
Const Middle As Byte = 2
Type decl
sOne As String
sMany1 As String
sMany2 As String
isMale As Byte
End Type
Public DecStr(3) As decl
Public sPost() As decl

Sub fInp(fName As String)
‘Чтение данных из файла
‘Copyright (c) 1998 Igor Ulyanchenko
‘e-mail: igorul@aha.ru
‘Параметр:
‘ fName – имя файла, обязательный

Dim declTmp As decl
Dim i As Integer, recNum As Integer
Dim sTmp As String, isOpen As Boolean

ChDir Application.ActiveWorkbook.Path
ChDrive Application.ActiveWorkbook.Path
isOpen = False
On Error GoTo err1
Open fName For Input Lock Write As #1
isOpen = True
recNum = 1
Do While Not EOF(1)
Input #1, declTmp.sOne, declTmp.sMany1, declTmp.sMany2, sTmp
recNum = recNum + 1
Loop
recNum = (recNum – 1) / 2
ReDim sPost(1 To recNum, 1 To 2)
Seek #1, 1
For i = 1 To recNum
Input #1, sPost(i, 1).sOne, sPost(i, 1).sMany1, sPost(i, 1).sMany2, sTmp
sPost(i, 1).isMale = CByte(sTmp)
Input #1, sPost(i, 2).sOne, sPost(i, 2).sMany1, sPost(i, 2).sMany2, sTmp
sPost(i, 2).isMale = CByte(sTmp)
Next i
Close #1
isOpen = False
Exit Sub
err1:
If isOpen Then
Close #1
End If
init False, “”
End Sub
Private Sub init(ReadData As Boolean, sPostfFName As String)
‘Инициализация
‘Copyright (c) 1998 Igor Ulyanchenko
‘e-mail: igorul@aha.ru
‘Параметры:
‘ ReadData – читать ли данные из файла
‘ sPostfFName – имя файла

Dim i As Integer, dataRows As Long
On Error GoTo err2
DecStr(0).sOne = “тысяча”
DecStr(0).sMany1 = “тысяч”
DecStr(0).sMany2 = “тысячи”
DecStr(0).isMale = Female

DecStr(1).sOne = “миллион”
DecStr(1).sMany1 = “миллионов”
DecStr(1).sMany2 = “миллиона”
DecStr(1).isMale = Male

DecStr(2).sOne = “миллиард”
DecStr(2).sMany1 = “миллиардов”
DecStr(2).sMany2 = “миллиарда”
DecStr(2).isMale = Male

DecStr(3).sOne = “триллион”
DecStr(3).sMany1 = “триллионов”
DecStr(3).sMany2 = “триллиона”
DecStr(3).isMale = Male
If ReadData Then
If sPostfFName = “” Then
‘читает данные из листа n2sdata
Dim n2sSheet As Worksheet
Set n2sSheet = Worksheets(“n2sdata”)
With n2sSheet
dataRows = .UsedRange.Rows.Count
If dataRows \ 2 <> dataRows / 2 Then
GoTo err2
End If
ReDim sPost(1 To dataRows / 2, 1 To 2)
For i = 2 To dataRows Step 2
sPost(i / 2, 1).sOne = .Cells(i – 1, 1).Text
sPost(i / 2, 1).sMany1 = .Cells(i – 1, 2).Text
sPost(i / 2, 1).sMany2 = .Cells(i – 1, 3).Text
sPost(i / 2, 1).isMale = CByte(.Cells(i – 1, 4).Text)
sPost(i / 2, 2).sOne = .Cells(i, 1).Text
sPost(i / 2, 2).sMany1 = .Cells(i, 2).Text
sPost(i / 2, 2).sMany2 = .Cells(i, 3).Text
sPost(i / 2, 2).isMale = CByte(.Cells(i, 4).Text)
Next i
End With
Else
‘чтает данные из файла
fInp sPostfFName
End If

Else
‘стандартный набор постфиксов
ReDim sPost(0 To 3, 1 To 2)
sPost(0, 1).sOne = “”
sPost(0, 1).sMany1 = “”
sPost(0, 1).sMany2 = “”
sPost(0, 1).isMale = Male

sPost(0, 2).sOne = “”
sPost(0, 2).sMany1 = “”
sPost(0, 2).sMany2 = “”
sPost(0, 2).isMale = Male

sPost(1, 1).sOne = “рубль”
sPost(1, 1).sMany1 = “рублей”
sPost(1, 1).sMany2 = “рубля”
sPost(1, 1).isMale = Male

sPost(1, 2).sOne = “копейка”
sPost(1, 2).sMany1 = “копеек”
sPost(1, 2).sMany2 = “копейки”
sPost(1, 2).isMale = Male

sPost(2, 1).sOne = “доллар”
sPost(2, 1).sMany1 = “долларов”
sPost(2, 1).sMany2 = “доллара”
sPost(2, 1).isMale = Male

sPost(2, 2).sOne = “цент”
sPost(2, 2).sMany1 = “центов”
sPost(2, 2).sMany2 = “цента”
sPost(2, 2).isMale = Male

sPost(3, 1).sOne = “руб.”
sPost(3, 1).sMany1 = “руб.”
sPost(3, 1).sMany2 = “руб.”
sPost(3, 1).isMale = Male

sPost(3, 2).sOne = “коп.”
sPost(3, 2).sMany1 = “коп.”
sPost(3, 2).sMany2 = “коп.”
sPost(3, 2).isMale = Female
End If
Exit Sub
err2:
init False, “”
End Sub
Private Function firstCaps(str As String) As String
‘Делает первую букву строки заглавной
‘Copyright (c) 1998 Igor Ulyanchenko
‘e-mail: igorul@aha.ru
‘Параметры:
‘ str – строка
‘Возвращает строку с первой заглавной буквой
firstCaps = UCase(Left(str, 1)) & Right(str, Len(str) – 1)
End Function
Private Function Postfix(ByRef Postf As decl, OMstate As Byte) As String
‘Возвращает постфикс строки
‘Copyright (c) 1998 Igor Ulyanchenko
‘e-mail: igorul@aha.ru
‘Параметры:
‘ Postf – постфиксы
‘ OMstate – признак числа
Select Case OMstate
Case sOne
Postfix = Postf.sOne
Case sMany1
Postfix = Postf.sMany1
Case sMany2
Postfix = Postf.sMany2
End Select
End Function
Public Function Num2Str(num As Variant, Optional isFirstCaps As Boolean = False, Optional isInt As Boolean = False, _
Optional FrASString As Boolean = True, Optional pGroup As Byte = 1, Optional ReadData As Boolean = False, _
Optional sPostfFName As String = “”) As String
‘Преобазование числа в текст
‘Copyright (c) 1998 Igor Ulyanchenko
‘e-mail: igorul@aha.ru
‘Параметры:
‘ num – содержит число для прелбразования, обязательный
‘ isFirstCaps – первая буква – прописная, по умолчанию False, необязательный
‘ isInt – отображать только целую часть (с округлением), по умолчанию False, необязательный
‘ FrASString – отображать целую часть как строку, по умолчанию True, необязательный
‘ pGroup – группа постфиксов, по умолчанию 1 (рубли, копейки), необязательный
‘ ReadData – читать данные из файла, по умончанию False, необязательный
‘ sPostfFName – имя файла из которого читать данные для постфиксов
‘Возвращает строку, содержащую текстовое представление числа

Dim curNum As Currency
Dim sInt As String, sFract As String, sTmp As String, sTmp2 As String
Dim OMstate As Byte
On Error GoTo Err03
init ReadData, sPostfFName
curNum = CCur(num)
separateValue curNum, sInt, sFract
If isInt Then ‘округление
If CByte(Left(sFract, 1)) >= 5 Then
curNum = Int(curNum) + 1
Else
curNum = Int(curNum)
End If
separateValue curNum, sInt, sFract
End If
sTmp = num2s(sInt, OMstate, pGroup)
If Right(sTmp, 1) <> ” ” Then sTmp = sTmp & sSpace
sTmp = sTmp & Postfix(sPost(pGroup, 1), OMstate)
If Not isInt Then
sTmp = sTmp & sSpace
If FrASString Then
If sFract = “00” Then
sTmp = sTmp & “ноль”
OMstate = sMany1
Else
sTmp = sTmp & nHundr2str(sFract, sPost(pGroup, 2).isMale, OMstate)
End If
Else
sTmp2 = nHundr2str(sFract, , OMstate) ‘устанавливает значение OMstate
sTmp = sTmp & sFract
End If
sTmp = sTmp & sSpace
sTmp = sTmp & Postfix(sPost(pGroup, 2), OMstate)
End If
If isFirstCaps Then sTmp = firstCaps(sTmp)
Num2Str = sTmp
Exit Function
Err03:
Num2Str = “#ОШИБКА ВО ВХОДНОМ ЗНАЧЕНИИ”
End Function
Public Sub separateValue(val As Currency, ByRef sInt As String, sFract As String)
‘Возвращает две строки, содержащие целую и дробную части числа
‘Copyright (c) 1998 Igor Ulyanchenko
‘e-mail: igorul@aha.ru
‘Параметры:
‘ val – число
‘ sInt – целая часть, строка
‘ sFract – дробная часть, строка

Dim sTmp As String
sTmp = Format(val, “###0.00”)
sFract = Right(sTmp, 2)
sInt = Left(sTmp, Len(sTmp) – 3)
End Sub
Private Function num2s(sNum As String, ByRef OMstate As Byte, Optional pGroup As Byte = Male) As String
‘Преобразует целое число в строку
‘Параметры:
‘ sNum – число
‘ OMstate – признак рода
‘ pGroup – группа постфиксов
‘Возвращает строку содержащую текстовое представление числа
Dim iSl As Byte, ic As Byte, iRazr As Byte, iGr As Byte
Dim sTmp As String, sTmp2 As String
sTmp = “”
iSl = Len(sNum)
If sNum = “0” Then
num2s = “ноль”
OMstate = sMany1
Exit Function
End If
iGr = ((iSl – 1) \ 3) * 3
If iSl > 3 Then
iRazr = CByte(iGr / 3 – 1)
sTmp = nHundr2str(Left(sNum, iSl – iGr), DecStr(iRazr).isMale, OMstate)
If sTmp <> “” Then
sTmp = sTmp & sSpace
‘вставка названия группы разрядов
sTmp = sTmp & Postfix(DecStr(iRazr), OMstate)
sTmp = sTmp & sSpace
End If

sTmp = sTmp & num2s(Right(sNum, iGr), OMstate, pGroup) ‘Рекурсивный вызов num2s
Else
sTmp = nHundr2str(Left(sNum, iSl – iGr), sPost(pGroup, 1).isMale, OMstate)
End If
num2s = sTmp
End Function

Private Function nHundr2str(sNum As String, Optional isMale As Byte = Male, Optional ByRef OMstate As Byte) As String
‘Преобразует число от 1 до 999 в текстовое представление
‘Copyright (c) 1998 Igor Ulyanchenko
‘e-mail: igorul@aha.ru
‘Параметры:
‘ sNum – число для преобразования
‘ isMale – признак рода
‘ OMstate – признак числа
‘Возвращает строку содержащую текстовое представление числа

Static sL, sM, sR, sTmp As String
OMstate = sMany1
sTmp = “”
Select Case Len(sNum)
Case 3
sL = Left(sNum, 1)
sM = Mid(sNum, 2, 1)
Case 2
sL = “0”
sM = Left(sNum, 1)
Case 1
sL = “0”
sM = “0”
End Select
sR = Right(sNum, 1)

Select Case sL
Case “1”
sTmp = “сто”
Case “2”
sTmp = “двести”
Case “3”
sTmp = “триста”
Case “4”
sTmp = “четыреста”
Case “5”
sTmp = “пятьсот”
Case “6”
sTmp = “шестьсот”
Case “7”
sTmp = “семьсот”
Case “8”
sTmp = “восемьсот”
Case “9”
sTmp = “девятьсот”
End Select
If sL <> “0” Then sTmp = sTmp & sSpace
Select Case sM
Case “1”
Select Case sR
Case “0”
sTmp = sTmp & “десять”
Case “1”
sTmp = sTmp & “одиннадцать”
Case “2”
sTmp = sTmp & “двенадцать”
Case “3”
sTmp = sTmp & “тринадцать”
Case “4”
sTmp = sTmp & “четырнадцать”
Case “5”
sTmp = sTmp & “пятнадцать”
Case “6”
sTmp = sTmp & “шестнадцать”
Case “7”
sTmp = sTmp & “семнадцать”
Case “8”
sTmp = sTmp & “восемнадцать”
Case “9”
sTmp = sTmp & “девятнадцать”
End Select
Case “2”
sTmp = sTmp & “двадцать”
Case “3”
sTmp = sTmp & “тридцать”
Case “4”
sTmp = sTmp & “сорок”
Case “5”
sTmp = sTmp & “пятьдесят”
Case “6”
sTmp = sTmp & “шестьдесят”
Case “7”
sTmp = sTmp & “семьдесят”
Case “8”
sTmp = sTmp & “восемьдесят”
Case “9”
sTmp = sTmp & “девяносто”
End Select
If sM <> “0” Then sTmp = sTmp & sSpace
If sM <> “1” Then
Select Case sR
Case “1”
Select Case isMale
Case Male
sTmp = sTmp & “один”
Case Female
sTmp = sTmp & “одна”
Case Middle
sTmp = sTmp & “одно”
End Select
OMstate = sOne
Case “2”
If isMale = Female Then sTmp = sTmp & “две” Else sTmp = sTmp & “два”
OMstate = sMany2
Case “3”
sTmp = sTmp & “три”
OMstate = sMany2
Case “4”
sTmp = sTmp & “четыре”
OMstate = sMany2
Case “5”
sTmp = sTmp & “пять”
Case “6”
sTmp = sTmp & “шесть”
Case “7”
sTmp = sTmp & “семь”
Case “8”
sTmp = sTmp & “восемь”
Case “9”
sTmp = sTmp & “девять”
End Select
End If
nHundr2str = sTmp
End Function

If you found an error, highlight it and press Shift + Enter or click here to inform us.

Author: master

Добавить комментарий

Ваш e-mail не будет опубликован. Обязательные поля помечены *