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

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 Сотрудники INNER JOIN Параметры ON Сотрудники. НомерСотр = Параметры. ГлБухгалтер", dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrFirmName = Nz (Rec. Fields ("НаименованиеФирмы"). Value, "")

StrFirmOKPO = Nz (Rec. Fields ("ОКПО"). Value, "")

StrGlBuch = Nz (Rec. Fields ("Сотрудник"). Value, "")

Else

MsgBox "Общие параметры фирмы не занесены!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = Nothing

Set Rec = db. OpenRecordset ("select * from запрос_ВнутренниеНакл where НомерНакл = " & nomer, dbOpenSnapshot)

If Rec. RecordCount > 0 Then

StrPodrazdName1 = Nz (Rec. Fields ("p1"). Value, "")

StrPodrazdOKPO1 = Nz (Rec. Fields ("p1_okpo"). Value, "")

StrPodrazdName2 = Nz (Rec. Fields ("p2"). Value, "")

StrPodrazdOKPO2 = Nz (Rec. Fields ("p2_okpo"). Value, "")

StrDate = Nz (Rec. Fields ("ДатаНакл"). Value, Date)

StrDate_s = Nz (Rec. Fields ("ДатаНаклСдал"). Value, Date)

StrDate_p = Nz (Rec. Fields ("ДатаНаклПринял"). Value, Date)

StrNomer = Nz (Rec. Fields ("НомерНаклВнутр"). Value, nomer)

StrSotrName1 = Nz (Rec. Fields ("s1"). Value, "")

StrSotrNomer1 = Nz (Rec. Fields ("s1_nomer"). Value, "")

StrSotrDolzh1 = Nz (Rec. Fields ("s1_dolzh"). Value, "")

StrSotrName2 = Nz (Rec. Fields ("s2"). Value, "")

StrSotrNomer2 = Nz (Rec. Fields ("s2_nomer"). Value, "")

StrSotrDolzh2 = Nz (Rec. Fields ("s2_dolzh"). Value, "")

StrPrim = Nz (Rec. Fields ("Примечание"). Value, "")

Else

MsgBox "Накладная №" & nomer & " не найдена!", vbCritical + vbOKOnly

Exit Sub

End If

Set Rec = Nothing

Set Rec = db. OpenRecordset ("select * from ВспомДата where НомерМес = " & Month (StrDate_s), 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 (StrDate_p), 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

Application. SysCmd acSysCmdInitMeter, "Вывод информации о товарах", 100

oApp. ActiveWorkbook. Sheets (1). Select

StrItog = 0

Set RecList = db. OpenRecordset ("select * from запрос_ВнутренниеНаклТовары where НомерНакл = " & nomer, dbOpenSnapshot)

NRecord = RecList. RecordCount

If NRecord > 0 Then

RecList. MoveLast

NRecord = RecList. RecordCount

RecList. MoveFirst

i = 0

oApp. ActiveWorkbook. Sheets (1). Select

p = rSh1_1 - 1: p2 = rSh1_2

While Not RecList. EOF

i = i + 1

p = p + 1

Application. SysCmd acSysCmdUpdateMeter, i / NRecord * 100

If p > p2 Then

oApp. ActiveWorkbook. Sheets (2). Select

p = rSh2_1: p2 = rSh2_2

End If

s_Sum = Nz (RecList. Fields ("Сумма"). Value, 0)

oApp. Cells (p, cNomer). Value = i

oApp. Cells (p, cTovar). Value = Nz (RecList. Fields ("Товар"). Value, "")

oApp. Cells (p, cYear). Value = Nz (RecList. Fields ("ГодВыпуска"). Value, Year (Date))

oApp. Cells (p, cInv). Value = Nz (RecList. Fields ("ИнвКод"). Value, Year (Date))

oApp. Cells (p, cKol). Value = Nz (RecList. Fields ("Количество"). Value, 0)

oApp. Cells (p, cCena). Value = Format$ (Nz (RecList. Fields ("ЦенаРозн"). Value, 0), "0.00")

oApp. Cells (p, cSum). Value = Format$ (s_Sum, "0.00")

StrItog = StrItog + s_Sum

RecList. MoveNext

Wend

Else

MsgBox "Для накладной №" & nomer & " нет перечня товаров!", vbCritical + vbOKOnly

Exit Sub

End If

Set RecList = Nothing

oApp. Cells (rFirmName, cFirmName). Value = StrFirmName

oApp. Cells (rFirmOKPO, cFirmOKPO). Value = StrFirmOKPO

oApp. Cells (rPodrazdName1, cPodrazdName1). Value = StrPodrazdName1

oApp. Cells (rPodrazdOKPO1, cPodrazdOKPO1). Value = StrPodrazdOKPO1

oApp. Cells (rPodrazdName2, cPodrazdName2). Value = StrPodrazdName2

oApp. Cells (rPodrazdOKPO2, cPodrazdOKPO2). Value = StrPodrazdOKPO2

oApp. Cells (rNomerNakl, cNomerNakl). Value = StrNomer

oApp. Cells (rDateNakl, cDateNakl). Value = Format$ (StrDate, "dd. mm. yyyy")

oApp. ActiveWorkbook. Sheets (2). Select

oApp. Cells (rSumItog, cSumItog). Value = " " & Format$ (StrItog, "0.00")

oApp. Cells (rSotrDolzh1, cSotrDolzh1). Value = StrSotrDolzh1

oApp. Cells (rSotrName1, cSotrName1). Value = StrSotrName1

oApp. Cells (rSotrNomer1, cSotrNomer1). Value = StrSotrNomer1

oApp. Cells (rDatDay1, cDatDay1). Value = Format$ (StrDate_s, "dd")

oApp. Cells (rDatMonth1, cDatMonth1). Value = StrMonth1

oApp. Cells (rDatYear1, cDatYear1). Value = Right$ (Format$ (StrDate_s, "yyyy"),

1)

oApp. Cells (rSotrDolzh2, cSotrDolzh2). Value = StrSotrDolzh2

oApp. Cells (rSotrName2, cSotrName2). Value = StrSotrName2

oApp. Cells (rSotrNomer2, cSotrNomer2). Value = StrSotrNomer2

oApp. Cells (rDatDay2, cDatDay2). Value = Format$ (StrDate_p, "dd")

oApp. Cells (rDatMonth2, cDatMonth2). Value = StrMonth2

 Скачать реферат