Автор: Пользователь скрыл имя, 10 Июня 2014 в 22:50, дипломная работа
В данном дипломном проекте была решена задача по автоматизации учета основных средств на предприятии ООО "Алеф". В качестве основы для автоматизации был выбран и сконфигурирован под нужды предприятия комплекс УСН 1С Бухгалтерия. Второй частью создания АРМ бухгалтера была разработка отдельного программного блока для формирования унифицированных форм учета основных средств предприятия. Программный блок был разработан в СУБД MS Access, что позволяет автономно быстро и легко формировать унифицированные формы документов. Основными плюсами разработанного модуля является его относительная автономность, низкая экономическая затратность, легкость с точки зрения технологической установки, а также широкие возможности по дальнейшему усовершенствованию. Проведена предварительная работа по подбору технических средств реализации блока, проанализирована и доказана его экономическая окупаемость. Продумана дальнейшая оптимизация бухгалтерского документооборота и учета на предприятии "Алеф" - добавление полной его интеграции с экспортными данными из программного комплекса УСН 1С Бухгалтерии 7.7.
РЕФЕРАТ
ВВЕДЕНИЕ
1. АНАЛИТИЧЕСКАЯ ЧАСТЬ
1.1 ОРГАНИЗАЦИОННО-ЭКОНОМИЧЕСКАЯ ХАРАКТЕРИСТИКА ПРЕДМЕТНОЙ ОБЛАСТИ. КРАТКОЕ ОПИСАНИЕ КОМПАНИИ ООО "АЛЕФ", АНАЛИЗ АДМИНИСТРАТИВНОЙ И ХОЗЯЙСТВЕННОЙ ДЕЯТЕЛЬНОСТИ ПРЕДПРИЯТИЯ
1.1.1 ОРГАНИЗАЦИОННАЯ СТРУКТУРА ОБЪЕКТА УПРАВЛЕНИЯ
1.1.2 ФУНКЦИОНАЛЬНАЯ ХАРАКТЕРИСТИКА ОБЪЕКТА УПРАВЛЕНИЯ
1.1.3 ЭКОНОМИЧЕСКАЯ ХАРАКТЕРИСТИКА ПРЕДМЕТНОЙ ОБЛАСТИ
1.2 ЭКОНОМИЧЕСКАЯ СУЩНОСТЬ КОМПЛЕКСА ЭКОНОМИЧЕСКИХ ИНФОРМАЦИОННЫХ ЗАДАЧ. РЕАЛИЗАЦИЯ ЭКОНОМИЧЕСКОЙ МОДЕЛИ ПРЕДПРИЯТИЯ С ПОМОЩЬЮ УЧЕТНОЙ СИСТЕМЫ 1С УCН
1.2.1 ОБЩИЕ СВЕДЕНИЯ О ЗАДАЧАХ. ОПИСАНИЕ ИМЕЮЩЕЙСЯ УЧЕТНОЙ СХЕМЫ ПРЕДПРИЯТИЯ В РАМКАХ УСН 1С
1.2.2 ОБОСНОВАНИЕ ВЫБОРА ЗАДАЧ, ВХОДЯЩИХ В КОМПЛЕКС. ПРЕИМУЩЕСТВА ОСНОВНОЙ УЧЕТНОЙ СИСТЕМЫ 1С УСН, А ТАКЖЕ НЕДОСТАЮЩИЕ ЗВЕНЬЯ АВТОМАТИЗИРОВАННОГО УЧЕТА
1.2.3 СПОСОБЫ РЕШЕНИЯ ЗАДАЧИ. ОБЩАЯ МОДЕЛЬ ПОДБОРА РЕШЕНИЯ
1.3 ОБОСНОВАНИЕ ПРОЕКТНЫХ РЕШЕНИЙ ПО АВТОМАТИЗИРОВАННОМУ РЕШЕНИЮ ЭКОНОМИКО-ИНФОРМАЦИОННЫХ ЗАДАЧ. ОСНОВНЫЕ МОМЕНТЫ АВТОМАТИЗАЦИИ УЧЕТА ДЕЯТЕЛЬНОСТИ ПРЕДПРИЯТИЯ. РЕШЕНИЕ НАШИХ ЗАДАЧ С ТОЧКИ ЗРЕНИЯ АВТОМАТИЗАЦИИ УЧЕТА НА ПРЕДПРИЯТИИ
1.3.1 ОБОСНОВАНИЕ ПРОЕКТНЫХ РЕШЕНИЙ ПО ИНФОРМАЦИОННОМУ ОБЕСПЕЧЕНИЮ КОМПЛЕКСА ЗАДАЧ. ПОДБОР ИНФОРМАЦИОННОГО ОБЕСПЕЧЕНИЯ ДЛЯ БЛОКА РАБОТЫ С УНИФИЦИРОВАННЫМИ ФОРМАМИ
1.3.2 ОБОСНОВАНИЕ ПРОЕКТНЫХ РЕШЕНИЙ ПО ТЕХНОЛОГИИ СБОРА, ПЕРЕДАЧИ, ОБРАБОТКИ И ВЫДАЧИ ИНФОРМАЦИИ. РЕАЛИЗАЦИЯ НЕДОСТАЮЩЕГО В УСН БЛОКА РАБОТЫ С УНИФИЦИРОВАННЫМИ ФОРМАМИ
1.3.3 ОБОСНОВАНИЕ ПРОЕКТНЫХ РЕШЕНИЙ ПО ПРОГРАММНОМУ ОБЕСПЕЧЕНИЮ КОМПЛЕКСА ЗАДАЧ
1.3.4 ОБОСНОВАНИЕ НЕОБХОДИМОСТИ ИСПОЛЬЗОВАНИЯ ВЫЧИСЛИТЕЛЬНОЙ ТЕХНИКИ И СОЗДАНИЯ АРМ ДЛЯ РЕШЕНИЯ ДАННОГО КОМПЛЕКСА ЗАДАЧ
2. ПРОЕКТНАЯ ЧАСТЬ
2.1 ИНФОРМАЦИОННОЕ ОБЕСПЕЧЕНИЕ КОМПЛЕКСА ЗАДАЧ
2.1.1 ИНФОЛОГИЧЕСКАЯ (ИНФОРМАЦИОННАЯ) МОДЕЛЬ (СХЕМА ДАННЫХ) И ЕЕ ОПИСАНИЕ
2.1.2 ИСПОЛЬЗУЕМЫЕ КЛАССИФИКАТОРЫ И СИСТЕМЫ КОДИРОВАНИЯ
2.1.3 ХАРАКТЕРИСТИКА ВХОДНОЙ ИНФОРМАЦИИ
2.1.4 НОРМАТИВНО-СПРАВОЧНАЯ ИНФОРМАЦИЯ
2.1.5 ХАРАКТЕРИСТИКА РЕЗУЛЬТАТНОЙ ИНФОРМАЦИИ
2.2 ВНУТРИМАШИННАЯ РЕАЛИЗАЦИЯ КОМПЛЕКСА ЗАДАЧ
2.2.1 ФОРМАЛИЗАЦИЯ РАСЧЕТОВ (АЛГОРИТМЫ РАСЧЕТА И РЕШЕНИЯ ЗАДАЧ)
2.2.2 СТРУКТУРНАЯ СХЕМА ИСПОЛЬЗОВАНИЯ КОМПЛЕКСА ПРОГРАММ (ДЕРЕВО ДИАЛОГА). ВЗАИМОДЕЙСТВИЕ УСН С БЛОКОМ ФОРМИРОВАНИЯ УНИФИЦИРОВАННЫХ ФОРМ
2.2.3 ОПИСАНИЕ ИНТЕРФЕЙСА ПРИЛОЖЕНИЯ.
2.3.1 ОРГАНИЗАЦИЯ ТЕХНОЛОГИИ СБОРА, ПЕРЕДАЧИ, ОБРАБОТКИ И ВЫДАЧИ ИНФОРМАЦИИ
2.3.2 СХЕМА ТЕХНОЛОГИЧЕСКОГО ПРОЦЕССА СБОРА, ПЕРЕДАЧИ, ОБРАБОТКИ И ВЫДАЧИ ИНФОРМАЦИИ
2.4 ПРОГРАММНОЕ ОБЕСПЕЧЕНИЕ КОМПЛЕКСА ЗАДАЧ
2.4.1 ОБЩИЕ ПОЛОЖЕНИЯ
2.4.2 СТРУКТУРНАЯ СХЕМА ПАКЕТА (ДЕРЕВО ВЫЗОВА ПРОЦЕДУР И ПРОГРАММ). ОПИСАНИЕ ПРОГРАММНЫХ МОДУЛЕЙ
2.5 СХЕМА ВЗАИМОСВЯЗИ ПРОГРАММНЫХ МОДУЛЕЙ И ИНФОРМАЦИОННЫХ ФАЙЛОВ
2.6 ВЫБОР И ОБОСНОВАНИЕ ТЕХНИЧЕСКИХ СРЕДСТВ
2.7 ЭКОНОМИЧЕСКОЕ ОБОСНОВАНИЕ ПРОЕКТА
ЗАКЛЮЧЕНИЕ
СПИСОК ИСПОЛЬЗОВАННЫХ ИСТОЧНИКОВ
StrKol = Nz (Rec. Fields ("Количество"). Value,
1)
StrDatePriem = Nz (Rec. Fields ("ДатаПринятия"). Value, Date)
StrDateSpis = Nz (Rec. Fields ("ДатаСписания"). Value, Date)
StrPost = Nz (Rec. Fields ("НаименованиеПост"). Value, "")
StrOsn = Nz (Rec. Fields ("ОснованиеПриема"). Value, "")
StrOper = Nz (Rec. Fields ("ВидОперации"). Value, "")
StrStruct = Nz (Rec. Fields ("СтруктурноеПодразделение"). Value, "")
StrOstStoim = Nz (Rec. Fields ("ОстСтоииость"). Value, 0)
StrOtvSotr = Nz (Rec. Fields ("ОтвСотр"). Value, "")
StrInvSotr = Nz (Rec. Fields ("ИнвСотр"). Value, "")
StrInvSotrDolzhn = Nz (Rec. Fields ("Должность"). Value, "")
Else
MsgBox "Инвентарная карточка №" & nomer & " не найдена!", vbCritical + vbOKOnly
Exit Sub
End If
Set Rec = Nothing
Set oApp = CreateObject ("Excel. Application")
oApp. Workbooks. Open FileName: =StrPath, ReadOnly: =True
oApp. ActiveWorkbook. Sheets (1). Select
oApp. Cells (rFirmName, cFirmName). Value = StrFirmName
oApp. Cells (rFirmOKPO, cFirmOKPO). Value = StrFirmOKPO
oApp. Cells (rNomer, cNomer). Value = NomerVnutr
oApp. Cells (rDat, cDat). Value = Format$ (StrDate, "dd. mm. yyyy")
oApp. Cells (rTovar, cTovar). Value = StrTovar
oApp. Cells (rMest, cMest). Value = StrMest
oApp. Cells (rSchet, cSchet). Value = StrSchet
oApp. Cells (rAmort, cAmort). Value = StrAmot
oApp. Cells (rInv, cInv). Value = StrInv
oApp. Cells (rDatePriem, cDatePriem). Value = Format$ (StrDatePriem, "dd. mm. yyyy")
oApp. Cells (rDateSpis, cDateSpis). Value = Format$ (StrDateSpis, "dd. mm. yyyy")
oApp. Cells (rPost, cPost). Value = StrPost
oApp. Cells (rPerv, cPerv). Value = Format$ (StrStoim, "0.00")
oApp. Cells (rSrok, cSrok). Value = StrSroki & " мес."
oApp. Cells (rOsn, cOsn). Value = StrOsn
oApp. Cells (rOper, cOper). Value = StrOper
oApp. Cells (rStruct, cStruct). Value = StrStruct
oApp. Cells (rOstStoim, cOstStoim). Value = Format$ (StrOstStoim, "0.00")
oApp. Cells (rOtvSotr, cOtvSotr). Value = StrOtvSotr
oApp. ActiveWorkbook. Sheets (2). Select
oApp. Cells (rTovar2, cTovar2). Value = StrTovar
oApp. Cells (rKol, cKol). Value = StrKol & " шт."
oApp. Cells (rInvDolzh, cInvDolzh). Value = StrInvSotrDolzhn
oApp. Cells (rInvName, cInvName). Value = StrInvSotr
ex:
Application. SysCmd acSysCmdRemoveMeter
If Not (oApp Is Nothing) Then oApp. Visible = True
Set Rec = Nothing
Set RecList = Nothing
Set oApp = Nothing
Set db = Nothing
Exit Sub
LblErr:
MsgBox Err. Description, vbCritical + vbOKOnly
GoTo ex
End Sub
Код модуля OS6b
Option Compare Database
Option Explicit
Private Const NomerForm As Long = 7
Private Const cFirmName As Byte = 1
Private Const rFirmName As Integer = 7
Private Const cFirmOKPO As Byte = 88
Private Const rFirmOKPO As Integer = 7
Private Const cStruct As Byte = 1
Private Const rStruct As Integer = 9
Private Const cDat1Day As Byte = 30
Private Const rDat1Day As Integer = 23
Private Const cDat1Mon As Byte = 34
Private Const rDat1Mon As Integer = 23
Private Const cDat1Year As Byte = 49
Private Const rDat1Year As Integer = 23
Private Const cDat2Day As Byte = 57
Private Const rDat2Day As Integer = 23
Private Const cDat2Mon As Byte = 61
Private Const rDat2Mon As Integer = 23
Private Const cDat2Year As Byte = 76
Private Const rDat2Year As Integer = 23
Private Const cInvName As Byte = 48
Private Const rInvName As Integer = 33
Private Const cInvDolzhn As Byte = 24
Private Const rInvDolzhn As Integer = 33
Private Const cInvNomer As Byte = 88
Private Const rInvNomer As Integer = 33
Private Const rSh1_1 As Integer = 8
Private Const rSh1_2 As Integer = 35
Private Const cNomer As Byte = 1
Private Const cTovar As Byte = 5
Private Const cInv As Byte = 20
Private Const cOsn As Byte = 30
Private Const cDatePrin As Byte = 43
Private Const cStructTov As Byte = 52
Private Const cOtv As Byte = 61
Private Const cPervStoim As Byte = 70
Private Const cSrok As Byte = 80
Private Const cAmort As Byte = 90
Private Const cOstStoim As Byte = 1
Sub PrintFormOS6b (ByVal v_dat1 As Date, _
ByVal v_dat2 As Date, _
ByVal nomer_struct As Long, ByVal StrStruct As String)
Dim db As Database, qry As DAO. QueryDef, Rec As DAO. Recordset, RecList As DAO. Recordset
Dim oApp As Object
Dim StrFormName As String
Dim StrFile As String, s_folder As String, StrPath As String
Dim StrFirmName As String, StrFirmOKPO As String
Dim StrInvOtvName As String, StrInvOtvDolzhn As String, StrInvOtvNomer As String
Dim StrMonth1 As String, StrMonth2 As String
Dim i As Long, NRecord As Long, p As Long
On Error GoTo LblErr
s_folder = CurrentProject. Path
If Right$ (s_folder,
1) <> "\" Then s_folder = s_folder + "\"
s_folder = s_folder + "blanks\"
If Len (Dir$ (s_folder, vbDirectory)) = 0 Then
MsgBox "Путь к папке с бланками " & s_folder & " не обнаружен!", vbCritical + vbOKOnly
Exit Sub
End If
Set db = CurrentDb
Set Rec = db. OpenRecordset ("select * from Формы where НомерФорма = " & NomerForm, dbOpenSnapshot)
If Rec. RecordCount > 0 Then
StrFormName = Rec. Fields ("Наименование"). Value
StrFile = Rec. Fields ("Файл"). Value
Else
Set Rec = Nothing
MsgBox "Нет информации о форме №" & NomerForm & "!", vbCritical + vbOKOnly
Exit Sub
End If
Set Rec = Nothing
StrPath = s_folder + StrFile
If Len (Dir$ (StrPath)) = 0 Then
MsgBox "Файл бланка формы '" & StrFormName & "' " & StrPath & " не обнаружен!", vbCritical + vbOKOnly
Exit Sub
End If
Set Rec = db. OpenRecordset ("SELECT Параметры. *, Сотрудники. Сотрудник, Сотрудники. ТабельныйНомер, Должности. Должность FROM ( (Должности RIGHT JOIN Сотрудники ON Должности. НомерДолжн = Сотрудники. НомерДолжн) RIGHT JOIN Параметры ON Сотрудники. НомерСотр = Параметры. ИнвОтвеств)", dbOpenSnapshot)
If Rec. RecordCount > 0 Then
StrFirmName = Nz (Rec. Fields ("НаименованиеФирмы"). Value, "")
StrFirmOKPO = Nz (Rec. Fields ("ОКПО"). Value, "")
StrInvOtvName = Nz (Rec. Fields ("Сотрудник"). Value, "")
StrInvOtvDolzhn = Nz (Rec. Fields ("Должность"). Value, "")
StrInvOtvNomer = Nz (Rec. Fields ("ТабельныйНомер"). Value, "")
Else
MsgBox "Общие параметры фирмы не занесены!", vbCritical + vbOKOnly
Exit Sub
End If
Set Rec = Nothing
Set Rec = db. OpenRecordset ("select * from ВспомДата where НомерМес = " & Month (v_dat1), dbOpenSnapshot)
If Rec. RecordCount > 0 Then
StrMonth1 = Nz (Rec. Fields ("НазвМес"). Value, "")
Else
StrMonth1 = "нет названия"
End If
Set Rec = Nothing
Set Rec = db. OpenRecordset ("select * from ВспомДата where НомерМес = " & Month (v_dat2), dbOpenSnapshot)
If Rec. RecordCount > 0 Then
StrMonth2 = Nz (Rec. Fields ("НазвМес"). Value, "")
Else
StrMonth2 = "нет названия"
End If
Set Rec = Nothing
Set oApp = CreateObject ("Excel. Application")
oApp. Workbooks. Open FileName: =StrPath, ReadOnly: =True
oApp. ActiveWorkbook. Sheets (1). Select
oApp. Cells (rFirmName, cFirmName). Value = StrFirmName
oApp. Cells (rFirmOKPO, cFirmOKPO). Value = StrFirmOKPO
oApp. Cells (rStruct, cStruct). Value = StrStruct
oApp. Cells (rDat1Day, cDat1Day). Value = Format$ (v_dat1, "dd")
oApp. Cells (rDat1Mon, cDat1Mon). Value = StrMonth1
oApp. Cells (rDat1Year, cDat1Year). Value = Right$ (Format$ (v_dat1, "yyyy"),
1)
oApp. Cells (rDat2Day, cDat2Day). Value = Format$ (v_dat2, "dd")
oApp. Cells (rDat2Mon, cDat2Mon). Value = StrMonth2
oApp. Cells (rDat2Year, cDat2Year). Value = Right$ (Format$ (v_dat2, "yyyy"),
1)
oApp. Cells (rInvName, cInvName). Value = StrInvOtvName
oApp. Cells (rInvDolzhn, cInvDolzhn). Value = StrInvOtvDolzhn
oApp. Cells (rInvNomer, cInvNomer). Value = StrInvOtvNomer
Application. SysCmd acSysCmdInitMeter, "Вывод информации о товарах", 100
If nomer_struct = 0 Then
Set qry = db. QueryDefs ("запрос_ИнвКнига2")
qry. Parameters (0) = v_dat1
qry. Parameters (1) = v_dat2
Else
Set qry = db. QueryDefs ("запрос_ИнвКнига")
qry. Parameters (0) = v_dat1
qry. Parameters (1) = nomer_struct
qry. Parameters (2) = v_dat2
End If
Set RecList = qry. OpenRecordset (dbOpenSnapshot)
NRecord = RecList. RecordCount
If NRecord > 0 Then
RecList. MoveLast
NRecord = RecList. RecordCount
RecList. MoveFirst
i = 0
p = rSh1_1 - 1
While Not RecList. EOF
i = i + 1
p = p + 1
If p > rSh1_2 Then GoTo ex
Application. SysCmd acSysCmdUpdateMeter, i / NRecord * 100
With oApp. ActiveWorkbook. Sheets (2)
. Cells (p, cNomer). Value = i
. Cells (p, cTovar). Value = Nz (RecList. Fields ("Наименование"). Value, "")
. Cells (p, cInv). Value = Nz (RecList. Fields ("ИнвНомер"). Value, "")
. Cells (p, cOsn). Value = Nz (RecList. Fields ("ОснованиеПринятия"). Value, "")
. Cells (p, cDatePrin). Value = Format$ (Nz (RecList. Fields ("ДатаПринятияКУчету"). Value, Date), "dd. mm. yyyy")
. Cells (p, cStructTov). Value = Nz (RecList. Fields ("СтруктурноеПодразделение"). Value, "")
. Cells (p, cOtv). Value = Nz (RecList. Fields ("Сотрудник"). Value, "")
. Cells (p, cPervStoim). Value = Nz (RecList. Fields ("ПервСтоииость"). Value, 0)
. Cells (p, cSrok). Value = Nz (RecList. Fields ("СрокИспользования"). Value, 0) & "мес."
. Cells (p, cAmort). Value = Nz (RecList. Fields ("Аморт"). Value, 0)
End With
oApp. ActiveWorkbook. Sheets (3). Cells (p, cOstStoim). Value = _
Nz (RecList. Fields ("ОстСтоииость"). Value, 0)
RecList. MoveNext
Wend
End If
ex:
Application. SysCmd acSysCmdRemoveMeter
If Not (oApp Is Nothing) Then oApp. Visible = True
Set qry = Nothing
Set RecList = Nothing
Set oApp = Nothing
Set db = Nothing
Exit Sub
LblErr:
MsgBox Err. Description, vbCritical + vbOKOnly
GoTo ex
End Sub
Код модуля общий
Option Compare Database
Option Explicit
Function translateNumber (ByVal Num As Long) As String
On Error GoTo LblErr
Dim num_str As String
Dim razr_count As Long
Dim razr_all As Long
Dim tri_count As Long
Dim tri_all As Long
Dim cur_dig As Byte
Dim point_pos As Long
Dim mg As Boolean
Dim mgl As Boolean
Dim kstr1 As Long
translateNumber = ""
num_str = Trim (Str (Num))
tri_count = 1
razr_all = Len (num_str)
If razr_all = 0 Then
translateNumber = "ноль"
Exit Function
End If
If Num = 0 Then
translateNumber = "ноль"
Exit Function
End If
For razr_count = 1 To razr_all Step 3
kstr1 = Mid (num_str, razr_all - razr_count + 1,1)
If razr_count = 1 Then mgl = True
If razr_count = 4 Then
mgl = True
If razr_count >= razr_all Then GoTo m1
If Mid (num_str, razr_all - razr_count,
1) = "1" Then
translateNumber = " тысяч" & translateNumber
Else
m1: If kstr1 = "1" Then translateNumber = " тысяча" & translateNumber
If kstr1 = "2" Then translateNumber = " тысячи" & translateNumber
If kstr1 = "3" Then translateNumber = " тысячи" & translateNumber
If kstr1 = "4" Then translateNumber = " тысячи" & translateNumber
If (Val (kstr1) >= 5) Or (kstr1 = "0") Then translateNumber = " тысяч" & translateNumber
End If
End If
If razr_count = 7 Then
mgl = False
If kstr1 = "1" Then translateNumber = " миллион" & translateNumber
If kstr1 = "2" Then translateNumber = " миллиона" & translateNumber
If kstr1 = "3" Then translateNumber = " миллиона" & translateNumber
If kstr1 = "4" Then translateNumber = " миллиона" & translateNumber
If (Val (kstr1) >= 5) Or (kstr1 = "0") Then translateNumber = " миллионов" & translateNumber
End If
If razr_count = 10 Then
mgl = False
If kstr1 = "1" Then translateNumber = " миллиард" & translateNumber
If kstr1 = "2" Then translateNumber = " миллиарда" & translateNumber
If kstr1 = "3" Then translateNumber = " миллиарда" & translateNumber
If kstr1 = "4" Then translateNumber = " миллиарда" & translateNumber
If (Val (kstr1) >= 5) Or (kstr1 = "0") Then translateNumber = " миллиардов" & translateNumber
End If
If razr_count = 13 Then
mgl = False
If kstr1 = "1" Then translateNumber = " триллион" & translateNumber
If kstr1 = "2" Then translateNumber = " триллиона" & translateNumber
If kstr1 = "3" Then translateNumber = " триллиона" & translateNumber
If kstr1 = "4" Then translateNumber = " триллиона" & translateNumber
If (Val (kstr1) >= 5) Or (kstr1 = "0") Then translateNumber = " триллионов" & translateNumber
End If
If razr_all - razr_count - 1 < 1 Then
translateNumber = triade (Mid (num_str, 1, razr_all - razr_count + 1), mgl) & translateNumber
Else
translateNumber = triade (Mid (num_str, razr_all - razr_count - 1,3), mgl) & translateNumber
End If
Next razr_count
translateNumber = ucasefirst (translateNumber)
Exit Function
LblErr:
MsgBox Err. Description
End Function
Function triade (ByVal in_str As String, mg As Boolean) As String
On Error GoTo LblErr
Dim out_tri2 As String
Dim out_tri1 As String
Dim out_tri3 As String
Dim di As String, kstr1 As String
triade = ""
If Len (in_str) < 3 Then in_str = "0" & in_str
If Len (in_str) < 3 Then in_str = "0" & in_str
kstr1 = Mid (in_str, 1,1)
If kstr1 = "0" Then out_tri3 = ""
If kstr1 = "1" Then out_tri3 = " сто"
If kstr1 = "2" Then out_tri3 = " двести"
If kstr1 = "3" Then out_tri3 = " триста"
If kstr1 = "4" Then out_tri3 = " четыреста"
If kstr1 = "5" Then out_tri3 = " пятьсот"
If kstr1 = "6" Then out_tri3 = " шестьсот"
If kstr1 = "7" Then out_tri3 = " семьсот"
If kstr1 = "8" Then out_tri3 = " восемьсот"
If kstr1 = "9" Then out_tri3 = " девятьсот"
'оцениваем на 11
di = Right (in_str,
2): kstr1 = Mid (in_str, 2,1)
If kstr1 = "1" Then
If di = "10" Then out_tri2 = " десять"
If di = "11" Then out_tri2 = " одиннадцать"
If di = "12" Then out_tri2 = " двенадцать"
If di = "13" Then out_tri2 = " тринадцать"
If di = "14" Then out_tri2 = " четырнадцать"
If di = "15" Then out_tri2 = " пятнадцать"
If di = "16" Then out_tri2 = " шестнадцать"
If di = "17" Then out_tri2 = " семнадцать"
If di = "18" Then out_tri2 = " восемнадцать"
If di = "19" Then out_tri2 = " девятнадцать"
triade = out_tri3 & out_tri2
Exit Function
End If
If kstr1 = "0" Then out_tri2 = ""
If kstr1 = "2" Then out_tri2 = " двадцать"
If kstr1 = "3" Then out_tri2 = " тридцать"
If kstr1 = "4" Then out_tri2 = " сорок"
If kstr1 = "5" Then out_tri2 = " пятьдесят"
If kstr1 = "6" Then out_tri2 = " шестьдесят"
If kstr1 = "7" Then out_tri2 = " семдесят"
If kstr1 = "8" Then out_tri2 = " восемдесят"
If kstr1 = "9" Then out_tri2 = " девяносто"
kstr1 = Mid (in_str, 3,1)
If kstr1 = "0" Then out_tri1 = ""
If mg = False Then
If kstr1 = "1" Then out_tri1 = " один"
If kstr1 = "2" Then out_tri1 = " два"
Else
If kstr1 = "1" Then out_tri1 = " одна"
If kstr1 = "2" Then out_tri1 = " две"
End If
If kstr1 = "3" Then out_tri1 = " три"
If kstr1 = "4" Then out_tri1 = " четыре"
If kstr1 = "5" Then out_tri1 = " пять"
If kstr1 = "6" Then out_tri1 = " шесть"
If kstr1 = "7" Then out_tri1 = " семь"
If kstr1 = "8" Then out_tri1 = " восемь"
If kstr1 = "9" Then out_tri1 = " девять"
triade = out_tri3 & out_tri2 & out_tri1
Exit Function
LblErr:
MsgBox Err. Description, vbCritical + vbOKOnly
End Function
Function ucasefirst (in_str As String) As String
On Error GoTo LblErr
Dim fs As String
Dim ns As String
If Nz (in_str, "") = "" Then ucasefirst = ""
in_str = Trim (in_str)
fs = Left (in_str,
1)
ns = Right (in_str, Len (in_str) - 1)
ucasefirst = UCase (fs) & ns
Exit Function
LblErr:
MsgBox Err. Description, vbCritical + vbOKOnly
End Function