.Shadow = False

.Underline = xlUnderlineStyleNone

.ColorIndex = xlAutomatic

End With

iw6.Cells(s, 1) = iw3.Cells(i, 1)

For qp = fi To s

Sum = Sum + iw6.Cells(qp, 7)

Next qp

iw6.Cells(s, 7) = Sum

fi = s + 1

Sum2 = Sum2 + Sum

Sum = 0

s = s + 1

GoTo 20

End If

s = s + 1

End If

20

Next i

'установка выделенного формата заголовков товарных групп

'подсчет всей суммы и суммы по товарным группам

For qp = fi To s

Sum = Sum + iw6.Cells(qp, 7)

Next qp

iw6.Cells(s, 7) = Sum

Sum2 = Sum2 + Sum

iw6.Cells(s + 1, 7) = Sum2

iw6.Cells(s + 1, 6) = "Общая"

'подсчет всей суммы и суммы по товарным группам

Range("D13:E1030").Select

Selection.NumberFormat = "0.00"

Range("A2").Select

Range("A13").Select

End Sub

Вывод счета осуществляется аналогично выводу счет-фактуры нажатием кнопки .

Sub Показ_Счета()

Set iw3 = Worksheets("Основная")

'вызов защиты от копирования

Call ПС

'вызов защиты от копирования

For i = 10 To 1009

If iw3.Cells(i, 6) < 0 Then

a = MsgBox("На складе нехватает товара, остаток на складе отрицателен", vbOKOnly + vbExclamation, "Сообщение")

GoTo 200

End If

Next i

srr = ActiveCell.Row

srr1 = ActiveCell.Columns().Column

If srr1 < 12 Or srr1 > 161 Then GoTo 150

If srr < 10 Or srr > 1009 Then GoTo 150

GoTo 201

150

a = MsgBox("Поставьте курсор на заказы фирм. Проверьте где находится курсор.", vbOKOnly + vbExclamation, "Сообщение")

Exit Sub

201

Set iw = Worksheets("Лист3")

Set iw1 = Worksheets("Счет1")

she = InputBox("Введите номер счета",,iw.Cells(1, 3))

If she = "" Then Exit Sub

iw.Cells(1, 3) = she + 1

iw1.Cells(18, 5) = she

Set iw3 = Worksheets("Основная")

Set iw6 = Worksheets("Счет1")

iw6.Cells(18, 10) = iw3.Cells(1, 9) 'Дата

sr1 = 0

ds = 0

kk = 0

'активация счета и очистка

Worksheets("Счет1").Activate

Range("B22:G71").Select

Selection.ClearContents

'активация счета и очистка

'реквизиты

iw6.Cells(2, 1) = "Поставщик: " & iw3.Cells(1, 14)

iw6.Cells(4, 1) = "Адрес: " & iw3.Cells(2, 14) & " " & iw3.Cells(3, 14)

iw6.Cells(5, 1) = "Расчетный счет № " & iw3.Cells(1, 21)

iw6.Cells(6, 1) = "в " & iw3.Cells(2, 21) & " г." & iw3.Cells(5, 21) & " БИК " & iw3.Cells(3, 21)

iw6.Cells(7, 1) = "кор.сч. " & iw3.Cells(4, 21)

iw6.Cells(9, 1) = "ИНН поставщика " & iw3.Cells(4, 14)

iw6.Cells(2, 6) = "Покупатель: " & iw3.Cells(7, srr1) & iw3.Cells(8, srr1) & iw3.Cells(9, srr1)

iw6.Cells(4, 6) = "Адрес: " & iw3.Cells(1011, srr1) & " " & iw3.Cells(1012, srr1)

iw6.Cells(5, 6) = "Расчетный счет № " & iw3.Cells(1014, srr1)

iw6.Cells(6, 6) = "в " & iw3.Cells(1015, srr1) & " г." & iw3.Cells(1018, srr1) & " БИК " & iw3.Cells(1016, srr1)

iw6.Cells(7, 6) = "кор.сч. " & iw3.Cells(1017, srr1)

iw6.Cells(9, 6) = "ИНН покупателя " & iw3.Cells(1013, srr1)

'реквизиты

For i = 10 To 1009

If iw3.Cells(i, srr1) = 0 Or Trim(iw3.Cells(i, srr1)) = "" Then

GoTo 15

Else

ds = ds + 1

If ds >= 51 Then GoTo 15

iw6.Cells(22 + sr1, 2) = iw3.Cells(i, 1) 'Название продукта

iw6.Cells(22 + sr1, 5) = iw3.Cells(i, 3) 'Единицы измерения

iw6.Cells(22 + sr1, 7) = iw3.Cells(i, 5) + iw3.Cells(6, 15) + (iw3.Cells(i, 5) + iw3.Cells(6, 15)) * iw3.Cells(i, 2) 'Цена товара

iw6.Cells(22 + sr1, 6) = iw3.Cells(i, srr1) 'Отгруженное количество товара

sr1 = sr1 + 1

End If

15:

Next i

'скрытие пустых строчек

Range("A22:G71").Select

ActiveWindow.ScrollColumn = 1

Selection.EntireRow.Hidden = False

For skrt = 22 To 71

If iw6.Cells(skrt, 2) = "" Then

ddm$ = "A" + Trim$(Str$(skrt)) + ":G" + "71"

Range(ddm$).Select

ActiveWindow.ScrollColumn = 1

Selection.EntireRow.Hidden = True

GoTo 200

End If

Next skrt

'скрытие пустых строчек

200

Range("A2").Select

Range("B22:D22").Select

End Sub

Данный код предназначен для скрытия строк основной таблицы. Это может понадобиться в случае резервации строк для вновь ожидаемых товаров для каждой ассортиментной группы. Операцию можно выполнить и вручную, но для этого придется снять, а потом и установить защиту листа. Этот макрос все сделает автоматически, достаточно выделить необходимые строки и щелкнуть на кнопке .

Sub Скрыть_строки()

Set iw6 = Worksheets("Основная")

sr = ActiveCell.Row

If sr < 10 Or sr > 1009 Then Exit Sub

'снять защиту листа

ActiveSheet.Unprotect

'снять защиту листа

ActiveWindow.ScrollColumn = 1

Selection.EntireRow.Hidden = True

'установить защиту листа

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

'установить защиту листа

End Sub

Обратная выше указанному действию команда. Оператор выделяет участок строк со скрытыми строками и щелкает по кнопке . Все скрытые строки указанного диапазона отображаются.

Sub Отобразить_строки()

'снять защиту листа

ActiveSheet.Unprotect

'снять защиту листа

Set iw6 = Worksheets("Основная")

sr = ActiveCell.Row

ActiveWindow.ScrollColumn = 1

Selection.EntireRow.Hidden = False

'установить защиту листа

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

'установить защиту листа

End Sub

Чтобы открыть не все скрытые строки, а по одной (например, по мере поступления новых товаров) нужно поместить курсор на строку выше скрытых строк и нажать на кнопке и одна следующая по порядку строка будет отображена.

Sub Отобразить_строкуI1()

'снять защиту листа

ActiveSheet.Unprotect

'снять защиту листа

Set iw6 = Worksheets("Основная")

sr = ActiveCell.Row

Range("A" + Trim$(Str$(sr + 1))).Select

ActiveWindow.ScrollColumn = 1

Selection.EntireRow.Hidden = False

'установить защиту листа

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

'установить защиту листа

End Sub

В конце рабочего дня все заказы, которые были осуществлены фирмами должны быть сминусованы от столбца «До отгрузки на складе», а сами удалены из поля заказов фирм. Для этого нужно щелкнуть на кнопке .

Sub Очистить_заказы()

a = MsgBox("Вы действительно хотите провести очистку", vbYesNo + vbExclamation, "Сообщение")

If a = vbYes Then

GoTo 10

Else

Exit Sub

End If

10

Range("F10:F1009").Select

Selection.Copy

Range("K10:K1009").Select

Range("K1009").Activate

Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=False

Range("J10:J1009").Select

Selection.ClearContents

Range("L10:FE1009").Select

Selection.ClearContents

Range("A10").Select

End Sub

Для быстрой навигации по таблице, в частности по наименованиям товаров, необходим поиск. Поиск с началом поля будет выполнен, если нажать на кнопке рядом со списком товаров.

Sub Поиск_товара()

she = InputBox("Введите начальный фрагмент искомого товара",,"")

If she = "" Then Exit Sub

she = UCase$(Trim$(she))

Set iw6 = Worksheets("Основная")

For i = 10 To 1009

If she = Mid$(UCase$(Trim$(iw6.Cells(i, 1))), 1, Len(she)) Then

Range("A" + Trim$(Str$(i))).Select

GoTo 10

End If

Next i

10

End Sub

Этот макрос активирует (открывает) лист «О программе». Можно поместить кнопку на главный лист и присвоить ей этот макрос при необходимости.

Sub Создатели()

Sheets("О программе").Select

End Sub

Аналогично действует код возврата при щелчке на кнопке .

Sub Назад_из_создателей()

Sheets("Основная").Select

End Sub

Поиск фирмы также необходим для быстрой навигации. Он проводится по второй строке названий фирм, т. к. в первой предполагается использование форм собственности - ООО, ТОО… Кнопка .

Sub Поиск_фирмы()

she = InputBox("Введите начальный фрагмент искомой фирмы. Поиск проводится по 8 строке.",,"")

If she = "" Then Exit Sub

she = UCase$(Trim$(she))

Set iw6 = Worksheets("Основная")

For i = 12 To 161

If she = Mid$(UCase$(Trim$(iw6.Cells(8, i))), 1, Len(she)) Then

If i = 12 Then d = "l"

If i = 13 Then d = "m"

If i = 14 Then d = "n"

If i = 15 Then d = "o"

If i = 16 Then d = "p"

If i = 17 Then d = "q"

If i = 18 Then d = "r"

If i = 19 Then d = "s"

If i = 20 Then d = "t"

If i = 21 Then d = "u"

If i = 22 Then d = "v"

If i = 23 Then d = "w"

If i = 24 Then d = "x"

If i = 25 Then d = "y"

If i = 26 Then d = "z"

If i = 27 Then d = "a"

If i = 28 Then d = "b"

If i = 29 Then d = "c"

If i = 30 Then d = "d"

If i = 31 Then d = "e"

If i = 32 Then d = "f"

If i = 33 Then d = "g"

If i = 34 Then d = "h"

If i = 35 Then d = "i"

If i = 36 Then d = "j"

If i = 37 Then d = "k"

If i = 38 Then d = "l"

If i = 39 Then d = "m"

If i = 40 Then d = "n"

If i = 41 Then d = "o"

If i = 42 Then d = "p"

If i = 43 Then d = "q"

If i = 44 Then d = "r"

If i = 45 Then d = "s"

If i = 46 Then d = "t"

If i = 47 Then d = "u"

If i = 48 Then d = "v"

If i = 49 Then d = "w"

If i = 50 Then d = "x"

If i = 51 Then d = "y"

If i = 52 Then d = "z"

If i > 26 And i < 53 Then d = "a" & d

If i = 53 Then d = "a"

If i = 54 Then d = "b"

If i = 55 Then d = "c"

If i = 56 Then d = "d"

If i = 57 Then d = "e"

If i = 58 Then d = "f"

If i = 59 Then d = "g"

If i = 60 Then d = "h"

If i = 61 Then d = "i"

If i = 62 Then d = "j"

If i = 63 Then d = "k"

If i = 64 Then d = "l"

If i = 65 Then d = "m"

If i = 66 Then d = "n"

If i = 67 Then d = "o"

If i = 68 Then d = "p"

If i = 69 Then d = "q"

If i = 70 Then d = "r"

If i = 71 Then d = "s"

If i = 72 Then d = "t"

If i = 73 Then d = "u"

If i = 74 Then d = "v"

If i = 75 Then d = "w"

If i = 76 Then d = "x"

If i = 77 Then d = "y"

If i = 78 Then d = "z"

If i > 52 And i < 79 Then d = "b" & d

If i = 79 Then d = "a"

If i = 80 Then d = "b"

If i = 81 Then d = "c"

If i = 82 Then d = "d"

If i = 83 Then d = "e"

If i = 84 Then d = "f"

If i = 85 Then d = "g"

If i = 86 Then d = "h"

If i = 87 Then d = "i"

If i = 88 Then d = "j"

If i = 89 Then d = "k"

If i = 90 Then d = "l"

If i = 91 Then d = "m"

If i = 92 Then d = "n"

If i = 93 Then d = "o"

If i = 94 Then d = "p"

If i = 95 Then d = "q"

If i = 96 Then d = "r"

If i = 97 Then d = "s"

If i = 98 Then d = "t"

If i = 99 Then d = "u"

If i = 100 Then d = "v"

If i = 101 Then d = "w"

If i = 102 Then d = "x"

If i = 103 Then d = "y"

If i = 104 Then d = "z"

If i > 78 And i < 105 Then d = "c" & d

If i = 105 Then d = "a"

If i = 106 Then d = "b"

If i = 107 Then d = "c"

If i = 108 Then d = "d"

If i = 109 Then d = "e"

If i = 110 Then d = "f"

If i = 111 Then d = "g"

If i = 112 Then d = "h"

If i = 113 Then d = "i"

If i = 114 Then d = "j"

If i = 115 Then d = "k"

If i = 116 Then d = "l"

If i = 117 Then d = "m"

If i = 118 Then d = "n"

If i = 119 Then d = "o"

If i = 120 Then d = "p"

If i = 121 Then d = "q"

If i = 122 Then d = "r"

If i = 123 Then d = "s"

If i = 124 Then d = "t"

If i = 125 Then d = "u"

If i = 126 Then d = "v"

If i = 127 Then d = "w"

If i = 128 Then d = "x"

If i = 129 Then d = "y"

If i = 130 Then d = "z"

If i > 104 And i < 131 Then d = "d" & d

If i = 131 Then d = "a"

If i = 132 Then d = "b"

If i = 133 Then d = "c"

If i = 134 Then d = "d"

If i = 135 Then d = "e"

If i = 136 Then d = "f"

If i = 137 Then d = "g"

If i = 138 Then d = "h"

If i = 139 Then d = "i"

If i = 140 Then d = "j"

If i = 141 Then d = "k"

If i = 142 Then d = "l"

If i = 143 Then d = "m"

If i = 144 Then d = "n"

If i = 145 Then d = "o"

If i = 146 Then d = "p"

If i = 147 Then d = "q"

If i = 148 Then d = "r"

If i = 149 Then d = "s"

If i = 150 Then d = "t"

If i = 151 Then d = "u"

If i = 152 Then d = "v"

If i = 153 Then d = "w"

If i = 154 Then d = "x"

If i = 155 Then d = "y"

If i = 156 Then d = "z"

If i > 130 And i < 157 Then d = "e" & d

If i = 157 Then d = "a"

If i = 158 Then d = "b"

If i = 159 Then d = "c"

If i = 160 Then d = "d"

If i = 161 Then d = "e"

If i > 156 And i < 162 Then d = "f" & d

Range(d + "10").Select

GoTo 10

End If

Next i

10

End Sub

Можно, конечно, щелкнуть по значку принтера на стандартной панели Excel для печати текущего листа, но лучше вынести отдельную кнопку для печати, т.к. это намного удобнее для утомленных глаз оператора, проводящего за монитором весь рабочий день. Во всех случаях используется кнопка .

Sub Печать_фактура1()

Worksheets("фактура1").PrintOut copies:=1

End Sub

Sub Печать_Накладная1()

Worksheets("Накладная1").PrintOut copies:=1

End Sub

Sub Печать_Счет1()

Worksheets("Счет1").PrintOut copies:=1

End Sub

Sub Печать_Прайс()

Worksheets("Прайс").PrintOut copies:=1

End Sub

Примитивная защита от копирования. Если программа не находит определенный файл с флагом, то выгружается из памяти.

Sub ПС()

Dim awe As String

awe = String$(1, " ")

Close

Open "C:\Windows\ПС.rus" For Binary As #1

Get #1, 1, awe

Close #1

If awe <> "1" Then

ActiveWorkbook.Close

ActiveProgramm.Close

End If

End Sub

Для просмотра статистики приходов-расходов каждого товара нужно поставить курсор на интересующий товар и нажать кнопку .

Sub Карточку_показать()

srr1 = ActiveCell.Columns().Column

If srr1 <> 1 Then GoTo 20

srr = ActiveCell.Row

If srr < 10 Or srr > 1009 Then GoTo 20

GoTo 30

20

a = MsgBox("Не выбран конкретный товар для вывода карточки. Проверьте где находится курсор.", vbOKOnly + vbExclamation, "Сообщение")

Exit Sub

30

srr = ActiveCell.Row

srr1 = ActiveCell.Columns().Column

If srr1 <> 1 Then Exit Sub

If srr < 10 Or srr > 1009 Then Exit Sub

Worksheets("Карточка").Activate

Range("B6:F1000").Select

Selection.ClearContents

Range("H6:H1000").Select

Selection.ClearContents

Range("B6").Select

Set iw3 = Worksheets("Основная")

Set iw6 = Worksheets("Карточка")

iw6.Cells(3, 3) = iw3.Cells(1, 9) 'Дата

iw6.Cells(2, 5) = iw3.Cells(srr, srr1) 'Товар

'файловый блок для карточек

i121 = 5

s120 = FreeFile

Open "C:\Мои документы\Temp\" & Trim(Str(srr)) & ".txt" For Binary As s120

Dim a120 As String

Dim a121 As String

a120 = String(54, " ")

Get s120, 1, a120

If Val(a120) < 1 Then Exit Sub

For i = 1 To Val(a120)

a121 = String(54, " ")

Get s120, i * 54 + 1, a121

i121 = i121 + 1

iw6.Cells(i121, 2) = Mid(a121, 1, 10) 'Дата

iw6.Cells(i121, 4) = Mid(a121, 11, 25) 'Кому

iw6.Cells(i121, 5) = Mid(a121, 36, 6) 'приход

iw6.Cells(i121, 6) = Mid(a121, 42, 6) 'Расход

iw6.Cells(i121, 8) = Mid(a121, 48, 7) 'Цена

Next i

Close

'файловый блок для карточек

For t = 6 To i121 + 5

If Trim(iw6.Cells(t, 5)) = "" Then iw6.Cells(t, 5) = "0"

If Trim(iw6.Cells(t, 6)) = "" Then iw6.Cells(t, 6) = "0"

Next t

ActiveSheet.Unprotect

Range("B6:I1001").Select

Selection.EntireRow.Hidden = False

Range("B6").Select

ddm$ = "A" + Trim$(Str$(i121 + 1)) + ":A" + "1000"

Range(ddm$).Select

Selection.EntireRow.Hidden = True

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

В конце отчетного периода возникает необходимость очистки всех карточек по товарам. Будет выполнен следующий код при щелчке на кнопке на листе «Карточка».

Sub Очистить_все_карточки()

a = MsgBox("Вы действительно хотите провести очистку", vbYesNo + vbExclamation, "Сообщение")

If a = vbYes Then

GoTo 1013

Else

Exit Sub

End If

1013

Range("B6:F1000").Select

Selection.ClearContents

Range("H6:H1000").Select

Selection.ClearContents

Range("B6").Select

Close

s120 = FreeFile

Open "C:\Мои документы\Temp\1.txt" For Binary As s120

Close

Kill "C:\Мои документы\TEMP\*.txt"

End Sub

Нажатием кнопки и кнопки (следующий макрос) можно скрыть от посторонних или фирм-клиентов конфиденциальную для своей фирмы информацию.

Sub Скрыть_столбцы_в_прайсе()

Range("F13:G13").Select

Selection.EntireColumn.Hidden = True

Range("A13").Select

End Sub

Sub Отобразить_столбцы_в_прайсе()

Range("E13:H13").Select

Selection.EntireColumn.Hidden = False

Range("A13").Select

End Sub

Так как шапка с реквизитами в «Основной» таблице ограничена рабочей областью экрана, то все реквизиты (такие как приходные цены, вес и др.) на экране расположить невозможно. Следующие два макроса показывают или скрывают дополнительные реквизиты, не уместившиеся на шапке.

Кнопка

Sub Показать_приходные_цены()

Range("L10:FO10").Select

ActiveSheet.Unprotect

Selection.EntireColumn.Hidden = True

Range("A10").Select

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

Кнопка

Sub Убрать_показ_приходных_цен()

ActiveSheet.Unprotect

Range("K10:FO10").Select

Selection.EntireColumn.Hidden = False

Range("A10").Select

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

Иногда бывает необходимо отпустить товар по приходным ценам или любым другим ценам, указанным в колонке «приходные цены».

Листинг кода кнопки приведен ниже:

Sub Показ_накладной_прихода()

Set iw3 = Worksheets("Основная")

srr = ActiveCell.Row

srr1 = ActiveCell.Columns().Column

If srr1 < 12 Or srr1 > 161 Then GoTo 150

If srr < 10 Or srr > 1009 Then GoTo 150

GoTo 201

150

a = MsgBox("Поставьте курсор на заказы фирм. Проверьте где находится курсор.", vbOKOnly + vbExclamation, "Сообщение")

Exit Sub

201

Set iw = Worksheets("Лист3")

Set iw1 = Worksheets("Накладная1")

she = InputBox("Введите номер накладной",,iw.Cells(1, 1))

If she = "" Then Exit Sub

Set iw3 = Worksheets("Основная")

Set iw6 = Worksheets("Накладная1")

iw6.Cells(20, 10) = iw3.Cells(1, 9) 'Дата

sr1 = 0

ds = 0 'счетчик

kk = 0

'Реквизиты фирмы

iw6.Cells(12, 4) = iw3.Cells(1, 14)

iw6.Cells(12, 10) = iw3.Cells(2, 14) & ", " & iw3.Cells(3, 14)

iw6.Cells(14, 4) = iw3.Cells(7, srr1) & iw3.Cells(8, srr1) & iw3.Cells(9, srr1)

iw6.Cells(14, 10) = iw3.Cells(1011, srr1) & ", " & iw3.Cells(1012, srr1)

'Реквизиты фирмы

'активация и очистка накладной

Worksheets("Накладная1").Activate

Range("A28:M77").Select

ActiveWindow.ScrollRow = 1

Selection.ClearContents

Range("O28:O77").Select

ActiveWindow.ScrollRow = 1

Selection.ClearContents

'активация и очистка накладной

For i = 10 To 1009

If iw3.Cells(i, srr1) = 0 Or Trim(iw3.Cells(i, srr1)) = "" Then

GoTo 15

Else

ds = ds + 1

If ds >= 51 Then GoTo 15

iw6.Cells(28 + sr1, 1) = sr1 + 1

iw6.Cells(28 + sr1, 2) = iw3.Cells(i, 1) 'товар

iw6.Cells(28 + sr1, 15) = iw3.Cells(i, 2) 'NDS

iw6.Cells(28 + sr1, 6) = iw3.Cells(i, 3) 'единицы измерения

iw6.Cells(28 + sr1, 8) = iw3.Cells(i, 7) 'Вид упаковки

iw6.Cells(28 + sr1, 9) = iw3.Cells(i, 8) 'в одном месте

iw6.Cells(28 + sr1, 10) = iw3.Cells(i, 9) 'мест, штук

iw6.Cells(28 + sr1, 12) = iw3.Cells(i, srr1) 'Отгруженное количество товара

iw6.Cells(28 + sr1, 13) = iw3.Cells(i, 172) 'Цена товара

sr1 = sr1 + 1

End If

15:

Next i

'скрытие пустых строк

Range("A28:Q77").Select

ActiveWindow.ScrollColumn = 1

Selection.EntireRow.Hidden = False

For skrt = 28 To 77

If iw6.Cells(skrt, 1) = "" Then

ddm$ = "A" + Trim$(Str$(skrt)) + ":Q" + "77"

Range(ddm$).Select

ActiveWindow.ScrollColumn = 1

Selection.EntireRow.Hidden = True

GoTo 12

End If

Next skrt

'скрытие пустых строк

12:

For i = 28 To 77

If iw6.Cells(i, 9) = "" Then GoTo 30

iw6.Cells(i, 10) = iw6.Cells(i, 12) / iw6.Cells(i, 9)

30

Next i

If iw3.Cells(1, 28) = "1" Then

iw6.Cells(79, 10) = "Налог с продаж 5%"

iw6.Cells(79, 17) = iw6.Cells(78, 17) * 0.05

Else

iw6.Cells(79, 10) = ""

iw6.Cells(79, 17) = ""

End If

200

Range("A1").Select

Range("B28:D28").Select

End Sub

Еще одна специфическая форма оптовой торговли. Вызывается нажатием кнопки . Ее листинг:

Sub Справка_Б()

Set iw3 = Worksheets("Основная")

srr = ActiveCell.Row

srr1 = ActiveCell.Columns().Column

If srr1 < 12 Or srr1 > 161 Then GoTo 150

If srr < 10 Or srr > 1009 Then GoTo 150

GoTo 201

150

a = MsgBox("Поставьте курсор на заказы фирм. Проверьте где находится курсор.", vbOKOnly + vbExclamation, "Сообщение")

Exit Sub

201

Set iw = Worksheets("Лист3")

Set iw1 = Worksheets("Справка Б")

she = InputBox("Введите номер справки Б к товарно-транспортной накладной",,iw.Cells(1, 1))

If she = "" Then Exit Sub

iw1.Cells(2, 5) = she

Set iw3 = Worksheets("Основная")

Set iw6 = Worksheets("Справка Б")

iw6.Cells(2, 6) = "от " & iw3.Cells(1, 9) 'Дата

sr1 = 0

ds = 0 'счетчик

kk = 0

'Реквизиты фирмы

iw6.Cells(13, 1) = iw3.Cells(1, 14) & ", " & iw3.Cells(2, 14) & ", " & iw3.Cells(3, 14)

iw6.Cells(22, 1) = iw3.Cells(4, 14)

iw6.Cells(80, 2) = iw3.Cells(3, 28) 'директор

iw6.Cells(24, 1) = iw3.Cells(4, 28) 'код по ОКПО

iw6.Cells(16, 1) = iw3.Cells(5, 28) '№ лицензии

iw6.Cells(13, 5) = iw3.Cells(7, srr1) & iw3.Cells(8, srr1) & iw3.Cells(9, srr1) & ", " & iw3.Cells(1011, srr1) & ", " & iw3.Cells(1012, srr1)

iw6.Cells(22, 5) = iw3.Cells(1013, srr1)

iw6.Cells(80, 6) = iw3.Cells(1021, srr1) 'директор

iw6.Cells(24, 5) = iw3.Cells(1022, srr1) 'код по ОКПО

iw6.Cells(16, 5) = iw3.Cells(1023, srr1) '№ лицензии

'Реквизиты фирмы

'активация и очистка бланка

Worksheets("Справка Б").Activate

Range("A25:H74").Select

ActiveWindow.ScrollRow = 1

Selection.ClearContents

Range("O28:O77").Select

ActiveWindow.ScrollRow = 1

Selection.ClearContents

'активация и очистка бланка

Sum = 0

For i = 10 To 1009

If iw3.Cells(i, srr1) = 0 Then

GoTo 15

Else

ds = ds + 1

If ds >= 51 Then GoTo 15

iw6.Cells(25 + sr1, 1) = iw3.Cells(i, 1) & iw3.Cells(i, 174) & " " & Trim$(Str$(iw3.Cells(i, 173) * iw3.Cells(i, srr1))) 'товар+рег.спец.марка

iw6.Cells(25 + sr1, 5) = iw3.Cells(i, 1) & iw3.Cells(i, 174) & " " & Trim$(Str$(iw3.Cells(i, 173) * iw3.Cells(i, srr1))) 'товар+рег.спец.марка

Sum = Sum + iw3.Cells(i, 173) * iw3.Cells(i, srr1)

sr1 = sr1 + 1

End If

15:

Next i

iw6.Cells(75, 4) = Sum

iw6.Cells(75, 8) = Sum

'скрытие пустых строк

Range("A25:H74").Select

ActiveWindow.ScrollColumn = 1

Selection.EntireRow.Hidden = False

For skrt = 25 To 74

If iw6.Cells(skrt, 1) = "" Then

ddm$ = "A" + Trim$(Str$(skrt)) + ":H" + "74"

Range(ddm$).Select

ActiveWindow.ScrollColumn = 1

Selection.EntireRow.Hidden = True

GoTo 200

End If

Next skrt

'скрытие пустых строк

200

'установка выравниваний и шрифтов

Range("A76:H76").Select

With Selection

.HorizontalAlignment = xlLeft

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = 0

.IndentLevel = 0

.ShrinkToFit = False

.MergeCells = False

End With

Range("A85").Select

Selection.Copy

Range("A76").Select

Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=False

Range("E76").Select

Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=False

Range("A76:D76").Select

Application.CutCopyMode = False

With Selection

.HorizontalAlignment = xlRight

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = 0

.ShrinkToFit = False

.MergeCells = True

End With

Range("E76:H76").Select

With Selection

.HorizontalAlignment = xlRight

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = 0

.ShrinkToFit = False

.MergeCells = True

End With

Range("A83").Select

ActiveCell.FormulaR1C1 = ""

Range("B83").Select

'установка выравниваний и шрифтов

'преобразование из денежного строкового формата в числовой строковый формат

On Error GoTo 197

iw6.Cells(76, 1) = Mid$(Trim$(iw6.Cells(76, 1)), 1, Len(Trim$(iw6.Cells(76, 1))) - 14)

iw6.Cells(76, 5) = Mid$(Trim$(iw6.Cells(76, 5)), 1, Len(Trim$(iw6.Cells(76, 5))) - 14)

197

On Error GoTo 0

'преобразование из денежного строкового формата в числовой строковый формат

Range("A9").Select

End Sub

Иногда необходимо удалить не всю карточку по конкретному товару, а последнюю запись в ней, будь то приход или расход. Следующий код удаляет из файла выбранного товара последнюю запись.

Кнопка

Sub Убрать_пос_тов_карточек()

srr1 = ActiveCell.Columns().Column

If srr1 <> 1 Then GoTo 20

srr = ActiveCell.Row

If srr < 10 Or srr > 1009 Then GoTo 20

GoTo 30

20

a = MsgBox("Не выбран конкретный товар для отката. Проверьте где находится курсор.", vbOKOnly + vbExclamation, "Сообщение")

Exit Sub

30

'файловый блок для карточек

s120 = FreeFile

Open "C:\Мои документы\Temp\" & Trim(Str(srr)) & ".txt" For Binary As s120

Dim a120 As String

a120 = String(54, " ")

Get s120, 1, a120

a99 = Val(Trim(a120)) - 1

If a99 <= 0 Then a99 = 0

a120 = Mid(Str(a99) & String(54, " "), 1, 54)

Put s120, 1, a120

Close s120

'файловый блок для карточек

a = MsgBox("Последняя запись в указанной карточке удалена", vbOKOnly + vbExclamation, "Сообщение")

End Sub

Следующий макрос удаляет файл карточек конкретного (одного) товара и выполняется нажатием кнопки .

Sub Удаление_конкретной_карточки()

srr1 = ActiveCell.Columns().Column

If srr1 <> 1 Then GoTo 20

srr = ActiveCell.Row

If srr < 10 Or srr > 1009 Then GoTo 20

GoTo 30

20

a = MsgBox("Не выбран конкретный товар для удаления. Проверьте где находится курсор.", vbOKOnly + vbExclamation, "Сообщение")

Exit Sub

30

Dim Msg, Style, Title, Ctxt, Response, MyString

Msg = "Вы действительно хотите удалить карточку по этому товару?"

Style = vbYesNo + vbCritical + vbDefaultButton2

Title = "Сообщение"

Response = MsgBox(Msg, Style, Title, Help, Ctxt)

If Response = vbYes Then

'файловый блок для карточек

s120 = FreeFile

Open "C:\Мои документы\Temp\" & Trim(Str(srr)) & ".txt" For Binary As s120

Close s120

Kill ("C:\Мои документы\Temp\" & Trim(Str(srr)) & ".txt")

a = MsgBox("Карточка по указанному товару очищена полностью", vbOKOnly + vbExclamation, "Сообщение")

'файловый блок для карточек

Else

Exit Sub

End If

End Sub

Когда необходимо снять количество товара на складе до или после отгрузки нужно щелкнуть на кнопке . Выходная форма будет представлена в виде накладной. В случае, когда товаров окажется больше чем 50, нужно еще раз щелкнуть по этой кнопке - будет выведена следующая накладная, если товаров еще больше, то ее придется нажать еще несколько раз.

Sub Остатки()

srr1 = ActiveCell.Columns().Column

If srr1 <> 6 And srr1 <> 10 And srr1 <> 11 Then GoTo 21

srr = ActiveCell.Row

If srr < 10 Or srr > 1009 Then GoTo 21

GoTo 31

21

a = MsgBox("Не выбран столбец для вывода. Проверьте где находится курсор. Возможные столбцы: Остаток на складе, Приход, До отгрузки на складе.", vbOKOnly + vbExclamation, "Сообщение")

Exit Sub

31

If srr1 = 11 Then awq = 10

If srr1 = 10 Then awq = 11

If srr1 = 6 Then awq = 12

If Лист3.Cells(1, awq) <> 10 Then

If srr1 = 11 Then aqq = " значения [до отгрузки на складе] "

If srr1 = 10 Then aqq = " значения [прихода] "

If srr1 = 6 Then aqq = " значения [остатков на складе] "

Dim Msg, Style, Title, Ctxt, Response, MyString

Msg = "Продолжить выводить" & aqq & "или начать вывод их же с начала. Если хотите продолжить - нажмите ДА, если нет - нажмите НЕТ. Комментарии: вы вывели эту же информацию прежде, но т.к. накладная содержит 50 строк полностью все данные не поместились, и вы можете продолжить процесс вывода либо начать все сначала."

Style = vbYesNo + vbDefaultButton2

Title = "Сообщение"

Response = MsgBox(Msg, Style, Title, Help, Ctxt)

If Response = vbYes Then

Else

Лист3.Cells(1, awq) = 10

End If

End If

Set iw = Worksheets("Лист3")

she = InputBox("Введите номер накладной-остатков",,iw.Cells(1, 1))

If she = "" Then Exit Sub

Set iw3 = Worksheets("Основная")

Set iw6 = Worksheets("Накладная1")

iw6.Cells(20, 10) = iw3.Cells(1, 9) 'Дата

sr1 = 0

ds = 0 'счетчик

kk = 0

'Реквизиты фирмы

iw6.Cells(12, 4) = iw3.Cells(1, 14)

iw6.Cells(12, 10) = iw3.Cells(2, 14) & ", " & iw3.Cells(3, 14)

iw6.Cells(14, 4) = iw3.Cells(7, srr1) & iw3.Cells(8, srr1) & iw3.Cells(9, srr1)

iw6.Cells(14, 10) = iw3.Cells(1011, srr1) & ", " & iw3.Cells(1012, srr1)

'Реквизиты фирмы

'активация и очистка бланка

Worksheets("Накладная1").Activate

Range("A28:M77").Select

ActiveWindow.ScrollRow = 1

Selection.ClearContents

Range("O28:O77").Select

ActiveWindow.ScrollRow = 1

Selection.ClearContents

'активация и очистка бланка

For i = Лист3.Cells(1, awq) To 1009

If iw3.Cells(i, srr1) = 0 Or Trim(iw3.Cells(i, srr1)) = "" Then

GoTo 15

Else

ds = ds + 1

If ds >= 51 Then

Лист3.Cells(1, awq) = i

GoTo 153

End If

iw6.Cells(28 + sr1, 1) = sr1 + 1

iw6.Cells(28 + sr1, 2) = iw3.Cells(i, 1) 'товар

iw6.Cells(28 + sr1, 15) = iw3.Cells(i, 2) 'NDS

iw6.Cells(28 + sr1, 6) = iw3.Cells(i, 3) 'единицы измерения

iw6.Cells(28 + sr1, 8) = iw3.Cells(i, 7) 'Вид упаковки

iw6.Cells(28 + sr1, 9) = iw3.Cells(i, 8) 'в одном месте

iw6.Cells(28 + sr1, 10) = iw3.Cells(i, 9) 'мест, штук

iw6.Cells(28 + sr1, 12) = iw3.Cells(i, srr1) 'Отгруженное количество товара

iw6.Cells(28 + sr1, 13) = iw3.Cells(i, 5) 'Цена товара

sr1 = sr1 + 1

End If

15

Next i

Лист3.Cells(1, awq) = 10

153

'скрытие пустых строк

Range("A28:Q77").Select

ActiveWindow.ScrollColumn = 1

Selection.EntireRow.Hidden = False

For skrt = 28 To 77

If iw6.Cells(skrt, 1) = "" Then

ddm$ = "A" + Trim$(Str$(skrt)) + ":Q" + "77"

Range(ddm$).Select

ActiveWindow.ScrollColumn = 1

Selection.EntireRow.Hidden = True

GoTo 12

End If

Next skrt

'скрытие пустых строк

12

For i = 28 To 77

If iw6.Cells(i, 9) = "" Then GoTo 30

iw6.Cells(i, 10) = iw6.Cells(i, 12) / iw6.Cells(i, 9)

30

Next i

If iw3.Cells(1, 28) = "1" Then

iw6.Cells(79, 10) = "Налог с продаж 5%"

iw6.Cells(79, 17) = iw6.Cells(78, 17) * 0.05

Else

iw6.Cells(79, 10) = ""

iw6.Cells(79, 17) = ""

End If

200

Range("A1").Select

Range("B28:D28").Select

End Sub

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

Sub Откат_карточек_последней_накладной()

If Лист3.Cells(2, 10) = "ВЫПОЛНЕН" Then GoTo 181

Dim Msg, Style, Title, Ctxt, Response, MyString

Msg = "Вы действительно хотите выполнить откат. Все последние записи во всех карточках, которые были дописаны при выводе последней накладной, будут удалены. Эту операцию рекомендуется использовать в том случае, когда вы ошибочно вывели накладную и вам не нужны данные по этой накладной, записанные в карточки."

Style = vbYesNo + vbCritical + vbDefaultButton2

Title = "Сообщение"

Response = MsgBox(Msg, Style, Title, Help, Ctxt)

If Response = vbYes Then

For i = 2 To 1010

If Лист3.Cells(i, 10) = "КОНЕЦ" Then GoTo 180

'файловый блок для карточек

s120 = FreeFile

Open "C:\Мои документы\Temp\" & Trim(Str(Лист3.Cells(i, 10))) & ".txt" For Binary As s120

Dim a120 As String

a120 = String(54, " ")

Get s120, 1, a120

a99 = Val(Trim(a120)) - 1

If a99 <= 0 Then a99 = 0

a120 = Mid(Str(a99) & String(54, " "), 1, 54)

Put s120, 1, a120

Close s120

'файловый блок для карточек

Next i

180

Лист3.Cells(2, 10) = "ВЫПОЛНЕН"

a = MsgBox("Откат выполнен успешно", vbOKOnly + vbExclamation, "Сообщение")

Exit Sub

Else

Exit Sub

End If

181

a = MsgBox("Для последней накладной откат был уже выполнен. Повторное выполнение отката для одной и тойже накладной невозможно. Это приведет к некорректному удалению записей карточек.", vbOKOnly + vbExclamation, "Сообщение")

End Sub

Выполнение той же операции только для прихода. Кнопка .

Sub Откат_карточек_последнего_прихода()

If Лист3.Cells(2, 11) = "ВЫПОЛНЕН" Then GoTo 181

Dim Msg, Style, Title, Ctxt, Response, MyString

Msg = "Вы действительно хотите выполнить откат. Все последние записи во всех карточках, которые были дописаны при прибавлении последнего прихода, будут удалены."

Style = vbYesNo + vbCritical + vbDefaultButton2

Title = "Сообщение"

Response = MsgBox(Msg, Style, Title, Help, Ctxt)

If Response = vbYes Then

For i = 2 To 1010

If Лист3.Cells(i, 11) = "КОНЕЦ" Then GoTo 180

'файловый блок для карточек

s120 = FreeFile

Open "C:\Мои документы\Temp\" & Trim(Str(Лист3.Cells(i, 11))) & ".txt" For Binary As s120

Dim a120 As String

a120 = String(54, " ")

Get s120, 1, a120

a99 = Val(Trim(a120)) - 1

If a99 <= 0 Then a99 = 0

a120 = Mid(Str(a99) & String(54, " "), 1, 54)

Put s120, 1, a120

Close s120

'файловый блок для карточек

Next i

180

Лист3.Cells(2, 11) = "ВЫПОЛНЕН"

a = MsgBox("Откат выполнен успешно", vbOKOnly + vbExclamation, "Сообщение")

Exit Sub

Else

Exit Sub

End If

181

a = MsgBox("Для последнего прихода откат был уже выполнен. Повторное выполнение отката для одного и того же прихода невозможно. Это приведет к некорректному удалению записей карточек.", vbOKOnly + vbExclamation, "Сообщение")

End Sub

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

Sub Учет()

Set iw3 = Worksheets("Основная")

Set iw6 = Worksheets("Учет")

Worksheets("Учет").Activate

Range("A4:A160").Select

Selection.ClearContents

Range("A4").Select

ind = 0

For i = 12 To 161

ind = ind + 1

iw6.Cells(3 + ind, 1) = iw3.Cells(7, i) & iw3.Cells(8, i) & iw3.Cells(9, i)

Next i

sm = 0

For i = 2 To 31

If Trim(iw6.Cells(3, i)) = "" Then

iw6.Cells(3, i) = iw3.Cells(1, 9) 'Дата

For k = 12 To 161

For j = 10 To 1009

sm = sm + iw3.Cells(j, k) * iw3.Cells(j, 5)

Next j

iw6.Cells(3 + k - 11, i) = sm

sm = 0

Next k

Лист3.Cells(4, 6) = ""

GoTo 10

End If

Next i

'сохранение

For l = 4 To 170

Лист3.Cells(l, 6) = ""

Next l

l2 = 3

For l = 3 To 160

l2 = l2 + 1

Лист3.Cells(l2, 6) = iw6.Cells(l, 2)

Next l

'сохранение

'смещение всех записей-столбцов на один столбец

Range("C3:AE166").Select

Selection.Copy

Range("B3").Select

ActiveSheet.Paste

Range("AE3:AE168").Select

Selection.ClearContents

ActiveWindow.ScrollColumn = 1

Range("B4").Select

'смещение всех записей-столбцов на один столбец

iw6.Cells(3, 31) = iw3.Cells(1, 9) 'Дата

For k = 12 To 161

For j = 10 To 1009

sm = sm + iw3.Cells(j, k) * iw3.Cells(j, 5)

Next j

iw6.Cells(3 + k - 11, 31) = sm

sm = 0

Next k

10

'скрытие пустых строк где нет фирм

Range("A4:A170").Select

Selection.EntireRow.Hidden = False

For skrt = 4 To 170

If iw6.Cells(skrt, 1) = "" Then

ddm$ = "A" + Trim$(Str$(skrt)) + ":A" + "170"

Range(ddm$).Select

ActiveWindow.ScrollColumn = 1

Selection.EntireRow.Hidden = True

GoTo 12

End If

Next skrt

'скрытие пустых строк где нет фирм

12

Range("A4").Select

End Sub

Макрос отката последнего нажатия кнопки . Кнопка на листе «учет».

Sub Откат_последнего_вывода()

Set iw6 = Worksheets("Учет")

If Лист3.Cells(4, 6) = "КОНЕЦ" Then

a = MsgBox("Для последнего вывода откат был уже выполнен.", vbOKOnly + vbExclamation, "Сообщение")

Exit Sub

End If

For i = 2 To 32

If Trim(iw6.Cells(3, i)) = "" And Лист3.Cells(4, 6) = "" Then

For l = 3 To 160

iw6.Cells(l, i - 1) = ""

Next l

Лист3.Cells(4, 6) = "КОНЕЦ"

Exit Sub

End If

Next i

'сдвиг столбцов в обратную сторону

Range("B3:AD171").Select

Selection.Copy

Range("C3").Select

ActiveSheet.Paste

Range("B4").Select

Range("B3:B171").Select

Selection.ClearContents

Range("B4").Select

'сдвиг столбцов в обратную сторону

For l = 3 To 170

iw6.Cells(l, 2) = Лист3.Cells(l + 1, 6)

Next l

Лист3.Cells(4, 6) = "КОНЕЦ"

End Sub

Функция сумма прописью. Данный код определяет следующую функцию: СуммаПрописью (Сумма) выводит сумму прописью для печати в счетах, накладных и пр.

Global Сумма As Currency, Остаток As Currency

Function Десятки(Разряд As Long) As String

Select Case Разряд

Case 2

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

Case 3

Десятки = "тридцать "

Case 4

Десятки = "сорок "

Case 5

Десятки = "пятьдесят "

Case 6

Десятки = "шестьдесят "

Case 7

Десятки = "семьдесят "

Case 8

Десятки = "восемьдесят "

Case 9

Десятки = "девяносто "

End Select

End Function

Function Единицы(Разряд As Long, Род As String) As String

Select Case Разряд

Case 1

If Род = "Мужской" Then

Единицы = "один "

Else

Единицы = "одна "

End If

Case 2

If Род = "Мужской" Then

Единицы = "два "

Else

Единицы = "две "

End If

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 Long) As String

If Разряд = 1 Then

Миллионы = "миллион "

ElseIf Разряд > 1 And Разряд < 5 Then

Миллионы = "миллиона "

Else

Миллионы = "миллионов "

End If

End Function

Function Рубли(Разряд As Long) As String

If Разряд = 1 Then

Рубли = "рубль"

ElseIf Разряд > 1 And Разряд < 5 Then

Рубли = "рубля"

Else

Рубли = "рублей"

End If

End Function

Function Сотни(Разряд As Long) As String

Select Case Разряд

Case 1

Сотни = "сто "

Case 2

Сотни = "двести "

Case 3

Сотни = "триста "

Case 4

Сотни = "четыреста "

Case 5

Сотни = "пятьсот "

Case 6

Сотни = "шестьсот "

Case 7

Сотни = "семьсот "

Case 8

Сотни = "восемьсот "

Case 9

Сотни = "девятьсот "

End Select

End Function

Function СуммаПрописью(СуммаСчета) As String

' Параметры: Используются глобальные параметры

' Сумма, Остаток и Подпись

' Назначение: Перевод СуммыСчета в строковую константу

' Возвращает: СуммуПрописью

Dim Группа As Long, Разряд As Long, Длина As Integer

Dim Пропись As String

Сумма = Int(СуммаСчета)

Остаток = Сумма

Группа = Остаток \ 1000000

If Группа <> 0 Then

Разряд = Группа \ 100

Пропись = Пропись & Сотни(Разряд)

Остаток = Остаток - Разряд * 100 * 1000000

Группа = Группа - Разряд * 100

If Группа > 19 Then

Разряд = Группа \ 10

Пропись = Пропись & Десятки(Разряд)

Остаток = Остаток - Разряд * 10 * 1000000

Группа = Группа - Разряд * 10

End If

Разряд = Группа

Пропись = Пропись & Единицы(Разряд, "Мужской")

Остаток = Остаток - Разряд * 1000000

Пропись = Пропись & Миллионы(Разряд)

End If

Группа = Остаток \ 1000

If Группа <> 0 Then

Разряд = Группа \ 100

Пропись = Пропись & Сотни(Разряд)

Остаток = Остаток - Разряд * 100 * 1000

Группа = Группа - Разряд * 100

If Группа > 19 Then

Разряд = Группа \ 10

Пропись = Пропись & Десятки(Разряд)

Остаток = Остаток - Разряд * 10 * 1000

Группа = Группа - Разряд * 10

End If

Разряд = Группа

Пропись = Пропись & Единицы(Разряд, "Женский")

Остаток = Остаток - Разряд * 1000

Пропись = Пропись & Тысячи(Разряд)

End If

Группа = Остаток

If Группа <> 0 Then

Разряд = Группа \ 100

Пропись = Пропись & Сотни(Разряд)

Остаток = Остаток - Разряд * 100

Группа = Группа - Разряд * 100

If Группа > 19 Then

Разряд = Группа \ 10

Пропись = Пропись & Десятки(Разряд)

Остаток = Остаток - Разряд * 10

Группа = Группа - Разряд * 10

End If

Разряд = Группа

Пропись = Пропись & Единицы(Разряд, "Мужской")

Остаток = Остаток - Разряд

Пропись = Пропись & Рубли(Разряд)

End If

Длина = Len(Пропись)

If IsNull(Длина) Then

Exit Function

End If

Пропись = UCase(Mid(Пропись, 1, 1)) & (Mid(Пропись, 2, Длина))

Пропись = Пропись & " " & Format$(100 * (СуммаСчета - Int(СуммаСчета)), "00") & " коп."

СуммаПрописью = Пропись

End Function

Function Тысячи(Разряд As Long) As String

If Разряд = 1 Then

Тысячи = "тысяча "

ElseIf Разряд > 1 And Разряд < 5 Then

Тысячи = "тысячи "

Else

Тысячи = "тысяч "

End If

End Function

3. Экономика

3.1 Оценка эффективности программных средств

Научно-технический прогресс в значительной степени определяется уровнем развития вычислительной техники и программного обеспечения. Целью создания программных средств является повышение эффективности производства в процессе их эксплуатации и оценивается эффективностью программного средства.

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

При определении экономической эффективности различают текущие и капитальные затраты. Текущие затраты характеризуют производимые постоянно в течение года затраты живого и овеществленного труда при автоматизации процесса работы. В отличие от текущих капитальные затраты - это средства в форме капитальных вложений на создание производственных фондов и их расширенное воспроизводство, на техническое перевооружение производства.

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

* определение затрат, необходимых для разработки и эксплуатации программного комплекса;

* определение экономического эффекта, который будет получен в результате введения разработанных программных средств.

Эффект показывает, какой результат получает отдельное предприятие в результате реализации мероприятий, направленных на повышение эффективности производства.

Экономический эффект бывает прямой и косвенный.

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

Косвенный эффект заключается:

В значительном увеличении скорости обработки информации.

В увеличении производительности труда.

В увеличении точности обработки и уменьшения возможных ошибок к допустимому минимуму.

В снижении людских ресурсов, требующихся в процессе обработки данных.

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

Оценка временных и людских затрат на решение задачи ручным и автоматизированным способами

Под ручным способом понимается существующий порядок выполнения работы. В него входит:

Подготовка к рабочему дню.

Обновление списка товаров на складе и всего количества остатков товаров на складе. Нужно расчерчивать аналог электронного склада на бумаге формата А2.

Рабочий день:

Занесение на счет каждой фирмы ее заказа по мере поступления такового.

Проверка наличия товаров на складе в сравнении с поступившими заказами.

Ручное заполнение и расчет на калькуляторе сумм накладной, счетов-фактур, счетов, справок.

Отдельный ввод и распечатка прайс-листов в MS Word.

Фиксация всех операций по приходам и расходам на отдельном листе.

В конце рабочего дня расчет суммарной суммы операций по каждой фирме.

Все эти функции закреплены за отделом бухгалтерии. Иные сотрудники не могут управлять никакими операциями самостоятельно в период отсутствия штатных сотрудников бухгалтерии, т.к. система учета слишком громоздкая и это может вызвать ошибки.

Состав отдела бухгалтерии:

Главный бухгалтер - 1чел.

Помощники главного бухгалтера - 3 чел.

Продолжительность рабочего дня сотрудников бухгалтерии составляет 8 часов, но, как правило, реальная продолжительность составляет порядка 10 часов, т.к. имеет место быть сильная перегрузка работой. При такой загрузке не редки и ошибки, а т.к. они связаны с налоговым учетом, то их исправление дорого обходится рассматриваемой фирме.

Под автоматизированным выполнением операций понимается использование программы «Учет» для быстрого и точного вывода и распечатки необходимых документов бухгалтерской отчетности.

Порядок выполнения работ:

1. Запуск и сохранение программы может выполняться любое количество раз по желанию оператора, т.к. это занимает минимальное время, а возможность запустить программу несколько раз может сильно облегчить труд по печати каких-либо нестандартных документов и прочее.

2. Ведение складского учета

Ведение складского учета заключается в своевременном занесении прихода и контроле остатков на складе. При необходимости можно добавить или удалить какой-нибудь товар или фирму. Адреса фирм-клиентов и собственные реквизиты вводятся один раз в начале эксплуатации программы.

3. Поиск необходимой фирмы и разнесение ее заказа, при наличие поиска по товарам занимает очень мало времени.

4. Непосредственно вывод необходимых документов и последующая печать. Вся информация по расходу автоматически заносится в карточки по каждому товару.

5. Фиксация результатов рабочего дня или отчетного периода (необходимо нажать две кнопки).

Сравнение временных затрат при ручном и автоматизированном труде затруднено тем, что при внедрении программы автоматизации бухгалтерии качественно измениться сама структура выполняемых работ. Например:

Исчезнет необходимость готовить лист учета всего склада формата А2. А около 150 документов, в среднем на каждый из них тратилось более 5 минут одним сотрудником, включая главного бухгалтера, будут рассчитываться почти мгновенно. Существенно упадет загрузка работающего персонала, а, следовательно, качественно повысится весь результат их труда.

Вся работа по фиксации результатов финансово-хозяйственной деятельности будет проводиться автоматически при каждой совершаемой операции.

Таким образом, производительность труда может повышаться в десятки раз и точный расчет её невозможен, т.к. в данном случае происходит изменение структуры выполняемых работ и переход на качественно новый уровень обработки информации.

Рассмотрим годовые экономические затраты на разработку и эксплуатацию разработанной комплексной программы автоматизации бухгалтерии.

3.2 Затраты на внедрение и разработку

При расчете затрат на внедрение и разработку в качестве денежных единиц используются рубли. Перевод из долларов в рубли осуществлялся по курсу 31,20 на 01.05.2002.

Затраты З складываются из капитальных затрат З_к, затрат на разработку З_р и затрат на эксплуатацию З_э.

З = З_к + З_р + З_э

Капитальные затраты З_к

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

В процессе разработки используется один компьютер.

Затраты на один компьютер:

Процессор AMD K7- 750 DURON	1245
Материнская плата Microstar MS-6380 (K7T266 Pro2) <SocketA, VIA КТ266, ATA100, Sound, ATX>	3235
Оперативная память DDR 512 Mb (pc-2100) Samsung	5205,5
Жесткий диск 60.0 Gb Seagate Barracuda ST360021А (7200)	3773
Видео система 32Mb <AGP> Microstar MSi-8820 (GeForce-2 GTS) DDR TV-Out	3038
Дисковод 1.44Mb 3.5" Mitsumi	300
DVD-ROM Samsung 616B 16x	1966,67
Корпус с блоком питания	1500
Мышь Mitsumi	200
Клавиатура CHICONY	250
Монитор 19" Samsung 955В	10000
Принтер HP LaserJet 1100 А4	7412,5
Итого:	38125,67

З_эвм = 38125,67 руб.

Затраты на программное обеспечение

Операционная система Microsoft Windows 98	2325,60
Microsoft Office Pro 2000 Rus Box	12000
Итого:	14325,60

З_по = 14325,60 руб.

З_к = 38125,67 + 14325,60 = 52451,27 руб.

Капитальные затраты также используются при расчете затрат на ремонт и модернизацию техники и программных средств.

Затраты на разработку за один месяц З_р

Основные составляющие затрат на разработку:

Заработная плата специалистов С_зрп, участвующих в создании программы;

Стоимость электроэнергии С_эл,израсходованной за месяц разработки;

Суммарная стоимость расходных материалов С_м (бумага, картриджи) и других текущих расходов;

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

З_р = С_зрп + С_эл + С_м

Заработная плата специалистов в месяц С_зрп

С_зрп = N * ЗРП * * R

N - количество специалистов, занятых разработкой задачи на ЭВМ

ЗРП - заработная плата специалиста, занятого постановкой задачи

- коэффициент, учитывающий премии и доплаты специалистам (1,3)

R - коэффициент отчислений на социальные нужды (1,395)

Программа разрабатывалась одним человеком

N=1

ЗРП = 7000 руб.

С_ЗРП =1 * 7000 * 1,3 * 1,395=12694,5 руб.

Стоимость электроэнергии за один месяц С_эл

C_эл=N_эл * Ц_эл * F

N_эл - мощность ЭВМ

N_эл - 0,35 кВт/ч

Ц_эл - стоимость одного кВт

Ц_эл - 0,3 руб/кВт

F - месячный фонд времени в часах

F - 8 часов в день * 21 день в месяц=168 ч

С_эл=0,35*168*0,3=17,64 руб.

Стоимость материалов и др. текущие затраты в месяц С_м

К данным затратам относятся:

Стоимость бумаги;

Стоимость картриджа для принтера;

Стоимость расходных материалов
Блок бумаги для струйной печати (500 листов)	150 руб
Картридж для принтера HP LaserJet 1100 (1500 страниц)	1650 руб

Месячная потребность в бумаге - 250 листов (0,5 блока, 0,15 картриджа)

С_м = 0,5 * 150+0,15 * 1650 = 322,5 руб.

Суммарные затраты за один месяц разработки

З_p = C_зрп + С_эл + С_м = 12694,5 + 17,64 + 322,5 = 13034,64 руб.

Затраты на эксплуатацию за один месяц З_э

В период эксплуатации программы основные затраты складываются из следующих составляющих:

Заработная плата оператора, включая отчисления на социальное страхование С_зрп;

Стоимость электричества С_эл;

Стоимость расходных материалов и проч. С_э;

Амортизационные отчисления А_1;

Затраты на эксплуатацию оборудования, приспособлений и инструментов, необходимые для решения задачи - ремонт; затраты на эксплуатацию рассчитываются по формуле:

З_э = С_зрп + С_эл + С_м + А₁ + С_рем

Заработная плата оператора в месяц С_зрп

С_зрп = N * ЗРП * * R

N - количество операторов, ЗРП - заработная плата оператора, - коэффициент, учитывающий премии и доплаты специалистам (1,3), R - коэффициент отчислений на социальные нужды (1,395)

N = 1

ЗРП = 6000 руб.

С_зрп = 1* 6000 * 1,3 * 1,395 = 10881 руб.

Стоимость электроэнергии за один месяц С_эл

С_эл = N_эл * Ц_эл* F

N_эл - мощность ЭВМ

N_эл = 0,35 кВт/ч

Ц_эл - стоимость одного кВт

Ц_эл= 0,3 руб/кВт

F- месячный фонд времени в часах

F= 8 часов в день * 21 день в месяц = 168ч

С_эл = 0,3 * 168 * 0,3 = 17,64 руб.

Стоимость материалов и др. текущие затраты в месяц С_м

К данным затратам, так же как и в процессе разработки, относятся:

Стоимость бумаги;

Стоимость картриджа для принтера;

Месячная потребность в бумаге - 3000 листов (6 блоков, 2 картриджа).

С_м=6*150 + 2 * 1650 = 4200 руб.

Амортизация (месячная) А1 Под амортизационными отчислениями понимается уменьшение потребительской стоимости оборудования, используемого в течение расчетного периода времени. В данном случае амортизация подвержены компьютеры и оргтехника. Целью амортизационных отчислений является повышение эффективности инвестиций посредством стимулирования приобретения нового актива взамен изношенного. Затраты на амортизацию рассчитываются по формуле:

А₁=З_к *

где - норма амортизации

Годовая норма амортизации составляет 25% от капитальных затрат, соответственно месячная составляет 25/12=2,083%

А₁ = 45496,87 * 0,02083 = 947,69 руб.

Затраты на ремонт оборудования в месяц С_рем

С_рем= З_к* З_ро

З_ро= 0,2708% от стоимости оборудования (3,5 % в год)

С_рем = 52451,27 * 0,002708 = 142,03 руб.

Суммарные месячные затраты на эксплуатацию

З_э=С_зрп+ С_эл + С_м+ А₁+ С_рем=

= 10881 + 17,64 + 4200 + 947,69 + 142,03 = 16188,36 руб.

Подсчет годовых затрат

Мы получили следующие данные:

Капитальные затраты составили З_к = 52451,27 руб.

Месяц разработки программы обходится в З_р = 13034,64 руб.

Месяц эксплуатации программы З_э = 16188,36 руб.

Разработка велась в течение t_р=3 месяцев. Эксплуатация соответственно составляет t_э = 12-3 = 9 месяцев.

З = З_к + З_р * t_р + З_э * t_э

З = 52451,27 + 13034,64 * 3 + 16188,36 * 9 = 237250 руб.

В результате проведенных расчетов видно, что годовые расходы на разработку и эксплуатацию комплексной программы автоматизации бухгалтерии «Учет» составили 237250 рублей. При этом, внедрение подобной системы приведет к замене существующего ручного способа ведения бухгалтерского и налогового учета работы бухгалтерии на автоматизированную структуру обработки информации с применением компьютера. Это приведет к снижению числа работников бухгалтерии с трех помощников бухгалтера до одного оператора, значительному повышению производительности труда и точности обработки информации, а также затрат фирмы.