Автоматизация учета основных средств на предприятии (стр. 28 из 29)

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 = " шестнадцать"