VBA Платежка

" Код Банка : " & Worksheets("Лист1").Range("P9")

№ПЛ = Worksheets("Лист1").Range("A1")

Windows("Клиенты" & Year(Date)).Activate

ComboBox1.Clear

МП = True

X = 1

Год = Year(Date)

While Len(Worksheets(№ПЛ).Range("A" & X)) <> 0

ComboBox1.AddItem (Worksheets(№ПЛ).Range("A" & X))

X = X + 1

Wend

End Sub

Private Sub ЗаПрошлыйГод_Click()

If Dir("C:\Program Files\Платёжка\Платёжки" & (Year(Date) - 1) & ".xls") =

_

"Платёжки" & (Year(Date) - 1) & ".xls" Then

Workbooks.Open FileName:="C:\Program Files\Платёжка\Платёжки" &

(Year(Date) - 1)

Windows("Платёжки" & (Year(Date) - 1)).Activate

Worksheets(№ПЛ).Select

Год = Year(Date) - 1

Else

БОКС = MsgBox("За прошлый год файл отчёта не найден", , BOX)

Exit Sub

End If

Вконец = True

End Sub

Private Sub Плательщики_Click()

UserForm1.Hide

UserForm3.Show

End Sub

Private Sub Отчёты_Click()

UserForm1.Hide

UserForm2.Show

End Sub

Private Sub Минус_Click() ' отнимает 1 день от даты

If IsDate(Дата) = True Then

Дата = CDate(Дата) - 1

Else

End If

End Sub

Private Sub Плюс_Click() ' прибавляет один день к дате

If IsDate(Дата) = True Then

Дата = CDate(Дата) + 1

Else

End If

End Sub

Private Sub Предосмотр_Click() ' активизирует окно просмотра Excel

Windows("Платёжка.xls").Activate

Application.Visible = True

UserForm1.Hide

ActiveWindow.SelectedSheets.PrintPreview

Application.Visible = False

UserForm1.Show

End Sub

Private Sub UserForm_Initialize()

If Dir("C:\Program Files\Платёжка\Клиенты" & Year(Date) & ".xls") <> _

"Клиенты" & Year(Date) & ".xls" Then

Workbooks.Open FileName:="C:\Program Files\Платёжка\Клиенты" & (Year(Date)

- 1)

Windows("Клиенты" & (Year(Date) - 1)).Activate

ActiveWorkbook.SaveAs FileName:="C:\Program Files\Платёжка\Клиенты" &

Year(Date)

Workbooks.Open FileName:="C:\Program Files\Платёжка\Платёжки" &

(Year(Date) - 1)

Windows("Платёжки" & (Year(Date) - 1)).Activate

ActiveWorkbook.SaveAs FileName:="C:\Program Files\Платёжка\Платёжки" &

Year(Date)

Workbooks.Open FileName:="C:\Program Files\Платёжка\Плательщики.xls"

Windows("Плательщики.xls").Activate

X = 1

Do While Len(Worksheets("Лист1").Range("A" & X)) <> 0

X = X + 1

Loop

X = X - 1

Do While X <> 0

Windows("Клиенты" & Year(Date)).Activate

Worksheets(CStr(X)).Select

Worksheets(CStr(X)).Range("L1:L65535").Select

Selection.ClearContents

Windows("Платёжки" & Year(Date)).Activate

Worksheets(CStr(X)).Select

Worksheets(CStr(X)).Columns("A:AG").Select

Selection.ClearContents

X = X - 1

Loop

Windows("Клиенты" & Year(Date)).Activate

ActiveWorkbook.Save

Windows("Платёжки" & Year(Date)).Activate

ActiveWorkbook.Save

Workbooks.Open FileName:="C:\Program Files\Платёжка\Платёжка.xls"

Windows("Плательщики.xls").Activate

Worksheets("Года").Select

X = 1

While Len(Worksheets("Года").Range("A" & X)) <> 0

X = X + 1

Wend

'Worksheets("Года").Range("A" & X) = CStr((Year(Date) - 1))

Worksheets("Года").Range("A" & X) = CStr(Year(Date))

ActiveWorkbook.Save

Else

Workbooks.Open FileName:="C:\Program Files\Платёжка\Клиенты" & Year(Date)

Workbooks.Open FileName:="C:\Program Files\Платёжка\Платёжки" & Year(Date)

Workbooks.Open FileName:="C:\Program Files\Платёжка\Платёжка.xls"

Workbooks.Open FileName:="C:\Program Files\Платёжка\Плательщики.xls"

End If

Год = Year(Date)

Счётчик2.List = Array(1, 2, 3)

Счётчик2 = 1

Дата = Date

МП = True

ComboBox1.Visible = True

НомерПл.Visible = False

Label1.Visible = True

Создать.Visible = False

Label14.Visible = False

Счётчик.Visible = False

КСтарПл.Visible = False

Предосмотр.Visible = False

Счётчик2.Visible = False

ИзмененияСТ.Visible = False

Вконец.Visible = False

номерСТПЛ.Visible = False

ПоНомеру.Visible = False

ЗаПрошлыйГод.Visible = False

Сегодня.Caption = "Сегодня : " & Date

BOX = "Платёжка"

Windows("Платёжка.xls").Activate

№ПЛ = Worksheets("Лист1").Range("a1")

Windows("Клиенты" & Year(Date)).Activate

X = 1

While Len(Worksheets(№ПЛ).Range("A" & X)) <> 0

ComboBox1.AddItem (Worksheets(№ПЛ).Range("A" & X))

X = X + 1

Wend

End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

Windows("Платёжки" & Year(Date)).Activate

ActiveWorkbook.Save

ActiveWindow.Close

Windows("Клиенты" & Year(Date)).Activate

ActiveWorkbook.Save

ActiveWindow.Close

Windows("Платёжка.xls").Activate

ActiveWorkbook.Save

ActiveWindow.Close

Application.Quit

'ActiveWorkbook.RunAutoMacros Which:=xlAutoClose

End Sub

Private Sub Измениния_Click()

Windows("Клиенты" & Year(Date)).Activate

If Проверка = False Then ' Проверка на правильность '

функция находится в конце программы

Exit Sub ' введённой информац

Else ' функция находится в конце программы

End If

X = 1

Do While X < ComboBox1.ListCount + 1

If Клиент = Worksheets(№ПЛ).Range("A" & X) _

And Банк = Worksheets(№ПЛ).Range("b" & X) _

And Счёт = Worksheets(№ПЛ).Range("c" & X) _

And КодБанка = Worksheets(№ПЛ).Range("d" & X) _

And УНН = Worksheets(№ПЛ).Range("e" & X) _

And ВидОперации = Worksheets(№ПЛ).Range("f" & X) _

And НомНазПл = Worksheets(№ПЛ).Range("H" & X) _

And НазначПлатежа1 = Worksheets(№ПЛ).Range("g" & ComboBox1.ListIndex +

1) _

Then

БОКС = MsgBox("Извените но : " & Клиент & " уже есть в списке

Получателей." _

& Chr(10) & "Попробуйте выбрать Получателя из списка.", , BOX)

Exit Sub

Else

X = X + 1

End If

Loop

Worksheets(№ПЛ).Range("A" & (ComboBox1.ListIndex + 1)) = Клиент

Worksheets(№ПЛ).Range("b" & (ComboBox1.ListIndex + 1)) = Банк

Worksheets(№ПЛ).Range("c" & (ComboBox1.ListIndex + 1)) = Счёт

Worksheets(№ПЛ).Range("d" & (ComboBox1.ListIndex + 1)) = КодБанка

Worksheets(№ПЛ).Range("e" & (ComboBox1.ListIndex + 1)) = УНН

Worksheets(№ПЛ).Range("f" & (ComboBox1.ListIndex + 1)) = ВидОперации

Worksheets(№ПЛ).Range("g" & (ComboBox1.ListIndex + 1)) = НазначПлатежа1

Worksheets(№ПЛ).Range("H" & (ComboBox1.ListIndex + 1)) = НомНазПл

ActiveWorkbook.Save

БОКС = MsgBox("Изменения в данные о Клиенте : " & Клиент & " успешно

внесёны в список клиентов", , BOX)

Клиент.SetFocus

End Sub

Private Sub ДобавитьПол_Click()

Windows("Клиенты" & Year(Date)).Activate

If Проверка = False Then ' Проверка на правильность

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

Exit Sub ' введённой информац

Else ' функция находится в конце программы

End If

X = 1

Do While X < ComboBox1.ListCount + 1

If Клиент = Worksheets(№ПЛ).Range("A" & X) _

And Банк = Worksheets(№ПЛ).Range("b" & X) _

And Счёт = Worksheets(№ПЛ).Range("c" & X) _

And КодБанка = Worksheets(№ПЛ).Range("d" & X) _

And УНН = Worksheets(№ПЛ).Range("e" & X) _

And ВидОперации = Worksheets(№ПЛ).Range("f" & X) _

And НомНазПл = Worksheets(№ПЛ).Range("H" & X) _

Then

БОКС = MsgBox("Извените но : " & Клиент & " уже есть в списке

Получателей." _

& Chr(10) & "Попробуйте выбрать Получателя из списка.", , BOX)

Exit Sub

Else

X = X + 1

End If

Loop

X = 1

While Len(Worksheets(№ПЛ).Range("A" & X)) <> 0

X = X + 1

Wend

Worksheets(№ПЛ).Range("A" & X) = Клиент

Worksheets(№ПЛ).Range("b" & X) = Банк

Worksheets(№ПЛ).Range("c" & X) = Счёт

Worksheets(№ПЛ).Range("d" & X) = КодБанка

Worksheets(№ПЛ).Range("e" & X) = УНН

Worksheets(№ПЛ).Range("f" & X) = ВидОперации

Worksheets(№ПЛ).Range("g" & X) = НазначПлатежа1

Worksheets(№ПЛ).Range("H" & X) = НомНазПл

ComboBox1.Visible = True

ComboBox1.AddItem (Worksheets(№ПЛ).Range("A" & (ComboBox1.ListCount +

1)))

ComboBox1.ListIndex = X - 1

ActiveWorkbook.Save

БОКС = MsgBox("Новый Клиент : " & Клиент & " внесён в список клиентов", ,

BOX)

Клиент.SetFocus

End Sub

Private Sub КСтарПл_Click()

Windows("Платёжка.xls").Activate

If Len(НомерПл) = 0 Then

БОКС = MsgBox("Вы не выбрали платёжку...", , BOX)

Exit Sub

Else

End If

If ПроверкаПЛ = False Then ' Проверка на правильность

Exit Sub ' введённой информации

Else ' функция находится в конце программы

End If

Вплатёжку 'функция сохраняющая данные в платёжке

ActiveWorkbook.Save

Windows("Платёжки" & Year(Date)).Activate

Worksheets(№ПЛ).Range("A" & НомерПл) = НомерПл

Worksheets(№ПЛ).Range("c" & НомерПл) = Банк

Worksheets(№ПЛ).Range("d" & НомерПл) = Счёт

Worksheets(№ПЛ).Range("b" & НомерПл) = Клиент

Worksheets(№ПЛ).Range("e" & НомерПл) = КодБанка

Worksheets(№ПЛ).Range("f" & НомерПл) = УНН

Worksheets(№ПЛ).Range("g" & НомерПл) = Деньги

Worksheets(№ПЛ).Range("h" & НомерПл) = Дата

Worksheets(№ПЛ).Range("I" & НомерПл) = ДатаУслуг

Worksheets(№ПЛ).Range("J" & НомерПл) = ВидОперации

Worksheets(№ПЛ).Range("K" & НомерПл) = НазначПлатежа1

Worksheets(№ПЛ).Range("L" & НомерПл) = НомНазПл

Worksheets(№ПЛ).Range("M" & НомерПл) = МП1

Windows("Платёжка.xls").Activate

Впечать 'функция печати

End Sub

Private Sub ИзмененияСТ_Click()

If Year(Дата) <> Год Then

БОКС = MsgBox("В дате должен стоять " & Год & " год", , BOX)

Exit Sub

End If

Windows("Платёжка.xls").Activate

If Len(НомерПл) = 0 Then

БОКС = MsgBox("Вы не выбрали платёжку...", , BOX)

Exit Sub

Else

End If

If ПроверкаПЛ = False Then ' Проверка на правильность

Exit Sub ' введённой информации

Else ' функция находится в конце программы

End If

Вплатёжку 'функция сохраняющая данные в платёжке

ActiveWorkbook.Save

Windows("Платёжки" & Год).Activate

Worksheets(№ПЛ).Range("A" & НомерПл) = НомерПл

Worksheets(№ПЛ).Range("c" & НомерПл) = Банк

Worksheets(№ПЛ).Range("d" & НомерПл) = Счёт

Worksheets(№ПЛ).Range("b" & НомерПл) = Клиент

Worksheets(№ПЛ).Range("e" & НомерПл) = КодБанка

Worksheets(№ПЛ).Range("f" & НомерПл) = УНН

Worksheets(№ПЛ).Range("g" & НомерПл) = CDbl(Деньги)

Worksheets(№ПЛ).Range("h" & НомерПл) = Дата

Worksheets(№ПЛ).Range("I" & НомерПл) = ДатаУслуг

Worksheets(№ПЛ).Range("J" & НомерПл) = ВидОперации

Worksheets(№ПЛ).Range("K" & НомерПл) = НазначПлатежа1

Worksheets(№ПЛ).Range("L" & НомерПл) = НомНазПл

Worksheets(№ПЛ).Range("M" & НомерПл) = МП1

ActiveWorkbook.Save

БОКС = MsgBox("Изменения в платёжку №: " & НомерПл & " успешно внесёны

", , BOX)

Клиент.SetFocus

End Sub

Private Sub Сегодня_Click()

Дата = Date

End Sub

Private Sub СтарыеПл_MouseMove(ByVal Button As Integer, ByVal Shift As

Integer, ByVal X As Single, ByVal Y As Single)

If СтарыеПл = False Then

Label16.Caption = " Нажав на эту кнопку Вы можете посмотреть все Ваши

старом платёжки" _

& " а так-же что-то подправить и сохранить эти изменения"

Else

Label16.Caption = " Нажав на эту кнопку Вы перейдёте к форме формирования

платёжек"

End If

End Sub

Private Sub Отчёты_MouseMove(ByVal Button As Integer, ByVal Shift As

Integer, ByVal X As Single, ByVal Y As Single)

Label16.Caption = "Кнопка 'Отчёты' для перехода в форму ОТЧЁТЫ. Там Вы

сможете узнать куда же делись Ваши деньги !!!"

End Sub

Private Sub Выход_MouseMove(ByVal Button As Integer, ByVal Shift As

Integer, ByVal X As Single, ByVal Y As Single)

Label16.Caption = "Кнопка 'Выход' для выхода из программы. Если решили

выйти смело жмите, программа сохранит результаты вашей работы."

End Sub

Private Sub УбитьКлиента_MouseMove(ByVal Button As Integer, ByVal Shift As

Integer, ByVal X As Single, ByVal Y As Single)

Label16.Caption = " Нажав на эту кнопку Вы можете удалить выбранного

Получателя из списка Получателей "

End Sub

Private Sub ПоНомеру_MouseMove(ByVal Button As Integer, ByVal Shift As

Integer, ByVal X As Single, ByVal Y As Single)

Label16.Caption = " Введите номер платёжки в расположенное рядом с этой

кнопкой небольшое поле. Затем нажмите на эту кнопку и вы перейдёте к

платёжке с введённым вами номером. "

End Sub

Private Sub Вконец_MouseMove(ByVal Button As Integer, ByVal Shift As

Integer, ByVal X As Single, ByVal Y As Single)

Label16.Caption = " Нажав на эту кнопку Вы осуществите переход к концу

списка платёжек "

End Sub

Private Sub Измениния_MouseMove(ByVal Button As Integer, ByVal Shift As

Integer, ByVal X As Single, ByVal Y As Single)

Label16.Caption = " Нажав на эту кнопку Вы внесёте изменения в список

Получателей "

End Sub

Private Sub ДобавитьПол_MouseMove(ByVal Button As Integer, ByVal Shift As

Integer, ByVal X As Single, ByVal Y As Single)

Label16.Caption = " Нажав на эту кнопку Вы внесёте в список Получателей

Ваших денег данные о новом Получателе "

End Sub

Private Sub ИзмененияСТ_MouseMove(ByVal Button As Integer, ByVal Shift As

Integer, ByVal X As Single, ByVal Y As Single)

Label16.Caption = " Нажав на эту кнопку Вы можете сохранить изменения в

старом платёжном поручении"

End Sub

Private Sub КСтарПл_MouseMove(ByVal Button As Integer, ByVal Shift As

Integer, ByVal X As Single, ByVal Y As Single)

Label16.Caption = " Нажав на эту кнопку Вы можете распечатать Ваше старое

платёжное поручения" _

& " Не забудьте выбрать кол-во копий в выпадающем списке рядом с кнопкой"

End Sub

Private Sub СохранитьНов_MouseMove(ByVal Button As Integer, ByVal Shift As

Integer, ByVal X As Single, ByVal Y As Single)

Label16.Caption = "Эта кнопка предназначена для сохранения созданного

платёжного поручения"

End Sub

Private Sub Создать_MouseMove(ByVal Button As Integer, ByVal Shift As

Integer, ByVal X As Single, ByVal Y As Single)

Label16.Caption = "Нажав на эту кнопку Вы можете распечатать Ваше

платёжное поручения" _

& " Не забудьте выбрать кол-во копий в выпадающем списке рядом с кнопкой"

End Sub

Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As

Integer, ByVal X As Single, ByVal Y As Single)

Label16.Caption = Платящий

End Sub

Private Sub Плательщики_MouseMove(ByVal Button As Integer, ByVal Shift As

Integer, ByVal X As Single, ByVal Y As Single)

Label16.Caption = "Нажав эту кнопка Вы можете поменять текущего

Плательщика или внести изменения в существующие данные о Плательщике"

End Sub

Private Sub Сегодня_MouseMove(ByVal Button As Integer, ByVal Shift As

Integer, ByVal X As Single, ByVal Y As Single)

Label16.Caption = "Кнопка для вставки текущей даты в формируемую платёжку"

End Sub

Private Sub КодБанка_MouseMove(ByVal Button As Integer, ByVal Shift As

Integer, ByVal X As Single, ByVal Y As Single)

Label16.Caption = "Обязательное поле. В это поле вносят код банка

Получателя. Допускаются только цифровые значения."

End Sub

Private Sub ComboBox1_MouseMove(ByVal Button As Integer, ByVal Shift As

Integer, ByVal X As Single, ByVal Y As Single)

Label16.Caption = "Что бы вставить данные Получателя платежа

востользуйтесь этим выпадающем списком. Если данные отсутствуют, значит

придётся добавить нового Получателя."

End Sub

Private Sub Label14_MouseMove(ByVal Button As Integer, ByVal Shift As

Integer, ByVal X As Single, ByVal Y As Single)

Label16.Caption = "Номер текущей платёжки"

End Sub

Private Sub Дата_MouseMove(ByVal Button As Integer, ByVal Shift As Integer,

ByVal X As Single, ByVal Y As Single)

Label16.Caption = "Обязательное поле. В это поле вносят дату формируемой

платёжки. Допускаются такие форматы дат. Пример : 01,01,200 или 01/01/2000

или 01.01/00"

End Sub

Private Sub УНН_MouseMove(ByVal Button As Integer, ByVal Shift As Integer,

ByVal X As Single, ByVal Y As Single)

Label16.Caption = "НЕ обязательное поле. В это поле вносят УНН Получателя.

Допускаются только цифровые значения."

End Sub

Private Sub НазначПлатежа1_MouseMove(ByVal Button As Integer, ByVal Shift

As Integer, ByVal X As Single, ByVal Y As Single)

Label16.Caption = "Обязательное поле. В это поле вносят сведения за что Вы

собственно платите." _

& "СОВЕТ если Вы знаете,что будете здесь писать почти всегда одно и тоже "

_

& "то нажмите кнопку Внести изменения в данные о Получателе."

End Sub

Private Sub Клиент_MouseMove(ByVal Button As Integer, ByVal Shift As

Integer, ByVal X As Single, ByVal Y As Single)

Label16.Caption = "Обязательное поле. В это поле вносят Наименование

Получателя. На пример: ""ООО Приятные Мелочи"""

End Sub

Private Sub Банк_MouseMove(ByVal Button As Integer, ByVal Shift As Integer,

ByVal X As Single, ByVal Y As Single)

Label16.Caption = "Обязательное поле. В это поле вносят Наименование Банка

Получателя. На пример: ""ОАО Белбизнесбанк г. Могилёв"""

End Sub

Private Sub Счёт_MouseMove(ByVal Button As Integer, ByVal Shift As Integer,

ByVal X As Single, ByVal Y As Single)

Label16.Caption = "Обязательное поле. В это поле вносят № расчётного счёта

Получателя. Допускаются только цифровые значения."

End Sub

Private Sub ДатаУслуг_MouseMove(ByVal Button As Integer, ByVal Shift As

Integer, ByVal X As Single, ByVal Y As Single)

Label16.Caption = "НЕ обязательное поле. В это поле вносят дату получения

товара или оказания услуг. Пример: Предоплата или 28 марта 2000г."

End Sub

Private Sub ВидОперации_MouseMove(ByVal Button As Integer, ByVal Shift As

Integer, ByVal X As Single, ByVal Y As Single)

Label16.Caption = "НЕ обязательное поле. В это поле вносят число

отражающее вид операции. Допускаются только цифровые значения."

End Sub

Private Sub НомНазПл_MouseMove(ByVal Button As Integer, ByVal Shift As

Integer, ByVal X As Single, ByVal Y As Single)

Label16.Caption = "НЕ обязательное поле. В это поле вносят число

отражающее код назначения платежа. Допускаются только цифровые значения."

End Sub

Private Sub Деньги_MouseMove(ByVal Button As Integer, ByVal Shift As

Integer, ByVal X As Single, ByVal Y As Single)

Label16.Caption = "Обязательное поле. В это поле вносят сумму платежа.

Допускаются только цифровые значения."

End Sub

Private Sub Минус_MouseMove(ByVal Button As Integer, ByVal Shift As

Integer, ByVal X As Single, ByVal Y As Single)

Label16.Caption = "Отнимает один день от текущей даты."

End Sub

Private Sub Плюс_MouseMove(ByVal Button As Integer, ByVal Shift As Integer,

ByVal X As Single, ByVal Y As Single)

Label16.Caption = "Добавляет один день к текущей дате."

End Sub

Private Sub СохранитьНов_Click()

If Year(Дата) <> Year(Date) Then

БОКС = MsgBox("Извините но в строке 'Дата' ошибка. Укажите текущий Год",

, BOX)

Дата.SetFocus

Exit Sub

End If

Windows("Платёжка.xls").Activate

If ПроверкаПЛ = False Then ' Проверка на правильность

Exit Sub ' введённой информации

Else ' функция находится в конце программы

End If

If ComboBox1.ListIndex = -1 Then

БОКС = MsgBox("Извините но Вы забыли внести Получателя : " & Клиент & " в

список Получателей ", , BOX)

Exit Sub

Else

End If

Windows("Клиенты" & Year(Date)).Activate

If Клиент <> ComboBox1 _

Or Счёт <> Worksheets(№ПЛ).Range("c" & ComboBox1.ListIndex + 1) _

Or Банк <> Worksheets(№ПЛ).Range("b" & ComboBox1.ListIndex + 1) _

Or КодБанка <> Worksheets(№ПЛ).Range("d" & ComboBox1.ListIndex + 1) _

Or УНН <> Worksheets(№ПЛ).Range("e" & ComboBox1.ListIndex + 1) _

Or ВидОперации <> Worksheets(№ПЛ).Range("f" & ComboBox1.ListIndex + 1) _

Or НомНазПл <> Worksheets(№ПЛ).Range("H" & ComboBox1.ListIndex + 1) _

Then

БОКС = MsgBox("Извините но Вы забыли внести Получателя : " & Клиент & "

в список Получателей ", , BOX)

Exit Sub

Else

End If

Счётчик2.Visible = True

Предосмотр.Visible = True

Вплатёжку 'функция сохраняющая данные в платёжке

ActiveWorkbook.Save

Windows("Платёжки" & Year(Date)).Activate

СохранитьНов.Visible = False

Создать.Visible = True

X = 1

While Len(Worksheets(№ПЛ).Range("A" & X)) <> 0

X = X + 1

Wend

Worksheets(№ПЛ).Select

Range("A" & X).Select

Selection.NumberFormat = "#,##0"

Worksheets(№ПЛ).Range("A" & X) = X

Range("g" & X).Select

Selection.NumberFormat = "#,##0"

Worksheets(№ПЛ).Range("g" & X) = CDbl(Деньги)

Worksheets(№ПЛ).Range("c" & X) = Банк

Worksheets(№ПЛ).Range("d" & X) = Счёт

Worksheets(№ПЛ).Range("b" & X) = Клиент

Worksheets(№ПЛ).Range("e" & X) = КодБанка

Worksheets(№ПЛ).Range("f" & X) = УНН

Worksheets(№ПЛ).Range("h" & X) = Дата

Worksheets(№ПЛ).Range("I" & X) = ДатаУслуг

Worksheets(№ПЛ).Range("J" & X) = ВидОперации

Worksheets(№ПЛ).Range("K" & X) = НазначПлатежа1

Worksheets(№ПЛ).Range("L" & X) = НомНазПл

Worksheets(№ПЛ).Range("M" & X) = МП1

Windows("Платёжка.xls").Activate

Worksheets("Лист1").Range("O2") = X

Windows("Клиенты" & Year(Date)).Activate

Worksheets(№ПЛ).Range("L" & ComboBox1.ListIndex + 1).NumberFormat = "@"

Worksheets(№ПЛ).Range("L" & ComboBox1.ListIndex + 1) = _

Worksheets(№ПЛ).Range("L" & ComboBox1.ListIndex + 1) + "" & X & "."

ActiveWorkbook.Save

Windows("Платёжки" & Year(Date)).Activate

ActiveWorkbook.Save

End Sub

Private Sub СтарыеПл_Click()

If СтарыеПл.Value = True Then

ComboBox1.Visible = False

НомерПл.Visible = True

Label1.Visible = False

Label14.Visible = True

Счётчик.Visible = True

Счётчик.SetFocus

КСтарПл.Visible = True

Создать.Visible = False

Измениния.Visible = False

ДобавитьПол.Visible = False

УбитьКлиента.Visible = False

СохранитьНов.Visible = False

ЗаПрошлыйГод.Visible = True

Счётчик2.Visible = True

Предосмотр.Visible = True

ИзмененияСТ.Visible = True

Вконец.Visible = True

номерСТПЛ.Visible = True

ПоНомеру.Visible = True

СтарыеПл.Caption = "Вернуться к созданию платёжек"

Счётчик = 0

Счёт = ""

Банк = ""

Клиент = ""

КодБанка = ""

УНН = ""

ВидОперации = ""

НазначПлатежа1 = ""

НомНазПл = ""

НомерПл = ""

Дата = ""

Деньги = ""

ДатаУслуг = ""

Else

If Год <> Year(Date) Then

Windows("Платёжки" & Год).Activate

ActiveWindow.Close

Год = Year(Date)

Else

End If

Дата = Date

Счёт = ""

Банк = ""

Клиент = ""

КодБанка = ""

УНН = ""

ВидОперации = ""

НазначПлатежа1 = ""

НомНазПл = ""

Деньги = ""

ДатаУслуг = ""

ComboBox1.ListIndex = True

НомерПл.Visible = False

Label1.Visible = True

Label14.Visible = False

Счётчик.Visible = False

КСтарПл.Visible = False

Измениния.Visible = True

ДобавитьПол.Visible = True

УбитьКлиента.Visible = True

СохранитьНов.Visible = True

ЗаПрошлыйГод.Visible = False

ComboBox1.Visible = True

Счётчик2.Visible = False

Предосмотр.Visible = False

ИзмененияСТ.Visible = False

Вконец.Visible = False

номерСТПЛ.Visible = False

ПоНомеру.Visible = False

СтарыеПл.Caption = "Посмотреть старые платёжки"

End If

End Sub

Private Sub Создать_Click()

Windows("Платёжка.xls").Activate

Впечать 'функция печати

Создать.Visible = False

Счётчик2.Visible = False

End Sub

Private Sub Счётчик_Change()

Windows("Платёжки" & Год).Activate

If Счётчик = 0 Then

Exit Sub

Else

Клиент = Worksheets(№ПЛ).Range("B" & Счётчик)

Счёт = Worksheets(№ПЛ).Range("D" & (Счётчик))

Банк = Worksheets(№ПЛ).Range("C" & (Счётчик))

НомерПл = Worksheets(№ПЛ).Range("A" & (Счётчик))

КодБанка = Worksheets(№ПЛ).Range("E" & (Счётчик))

УНН = Worksheets(№ПЛ).Range("F" & (Счётчик))

Деньги = Worksheets(№ПЛ).Range("g" & Счётчик)

ДатаУслуг = Worksheets(№ПЛ).Range("I" & Счётчик)

ВидОперации = Worksheets(№ПЛ).Range("J" & Счётчик)

НазначПлатежа1 = Worksheets(№ПЛ).Range("K" & Счётчик)

НомНазПл = Worksheets(№ПЛ).Range("L" & Счётчик)

Дата = Worksheets(№ПЛ).Range("h" & Счётчик)

МестоПечати1 'функция работающая с МП,БП, БезПечати

'задаёт значения этим компонентам

Windows("Платёжка.xls").Activate

Вплатёжку 'функция сохраняющая данные в платёжке

End If

End Sub

Private Sub УбитьКлиента_Click()

Windows("Клиенты" & Year(Date)).Activate

If Len(ComboBox1) = 0 Then

БОКС = MsgBox("Вы не выбрали не одного Получателя для удаления...", ,

BOX)

Exit Sub

'ElseIf ComboBox1.ListIndex = -1 Then

End If

Dim a

a = ComboBox1

БОКС = MsgBox("Вы действительно хотите удалить Получателя : " & a,

vbYesNo, BOX)

If БОКС <> vbYes Then

Exit Sub

ElseIf Len(Worksheets(№ПЛ).Range("L" & ComboBox1.ListIndex + 1)) <> 0

Then

БОКС = MsgBox("Извините, но Вы не можете удалить Получателя : " & a _

& Chr(10) & "так-как по нему производились платежи. " _

& Chr(10) & "Удалить этого Получателя Будет можно лишь УДАЛИВ ПЛАТЕЛЬЩИКА

!!! " _

& Chr(10) & "В форме ПЛАТЕЛЬЩИКИ !!!" & Chr(10) & Chr(10) & _

Платящий, vbCritical, BOX)

Exit Sub

End If

If ComboBox1.ListIndex = -1 Then

Exit Sub

Else

Windows("Клиенты" & Year(Date)).Activate

Worksheets(№ПЛ).Select

Rows(ComboBox1.ListIndex + 1).Select

Selection.Delete Shift:=xlUp 'Удаляем запись о клиенте

a = ComboBox1

ComboBox1.RemoveItem (ComboBox1.ListIndex)

ActiveWorkbook.Save

БОКС = MsgBox("Вы удалили Получателя : " & a, , BOX)

ComboBox1.ListIndex = -1

Счёт = ""

Банк = ""

Клиент = ""

КодБанка = ""

УНН = ""

ВидОперации = ""

НазначПлатежа1 = ""

НомНазПл = ""

НомерПл = ""

Деньги = ""

ДатаУслуг = ""

End If

End Sub

Private Sub Вконец_Click()

Windows("Платёжки" & Год).Activate

X = 1

While Len(Worksheets(№ПЛ).Range("A" & (X))) <> 0

X = X + 1

Wend

Счётчик.Value = X - 1

End Sub

Private Sub ПоНомеру_Click()

If Len(номерСТПЛ) = 0 Then

БОКС = MsgBox("Вы забыли ввести номер платёжки", , BOX)

номерСТПЛ.SetFocus

Exit Sub

ElseIf номерСТПЛ > 0 And номерСТПЛ < 65501 Then

Счётчик.Value = номерСТПЛ

номерСТПЛ = ""

номерСТПЛ.SetFocus

Else

Вконец = True

БОКС = MsgBox("Был введён № несуществующей платёжки... Поэтому выполнен

переход к концу списка платёжек ", , BOX)

номерСТПЛ.SetFocus

Exit Sub

End If

If Len(НомерПл) = 0 Then

Вконец = True

БОКС = MsgBox("Был введён № несуществующей платёжки... Поэтому выполнен

переход к концу списка платёжек ", , BOX)

номерСТПЛ.SetFocus

Else

End If

End Sub

Private Function TRIMF()

Клиент = TRIM(Клиент)

Банк = TRIM(Банк)

Счёт = TRIM(Счёт)

КодБанка = TRIM(КодБанка)

Счёт = TRIM(Счёт)

КодБанка = TRIM(КодБанка)

УНН = TRIM(УНН)

ВидОперации = TRIM(ВидОперации)

НомНазПл = TRIM(НомНазПл)

Дата = TRIM(Дата)

ДатаУслуг = TRIM(ДатаУслуг)

НазначПлатежа1 = TRIM(НазначПлатежа1)

Деньги = TRIM(Деньги)

End Function

Private Function Проверка() As String

TRIMF

If ПроверкаОБЩ = False Then

Проверка = False

Exit Function

Else

Проверка = True

End If

End Function

Private Function ПроверкаПЛ() As String

TRIMF

If ПроверкаОБЩ = False Then

ПроверкаПЛ = False

Exit Function

Else

End If

If Len(НазначПлатежа1) = 0 Then

MsgBox "Извините но в 'Строке Введите Назначение Платежа' пусто"

НазначПлатежа1.SetFocus

ПроверкаПЛ = False

Exit Function

ElseIf IsDate(Дата) = False Then

MsgBox "Извините но в 'Строке Дата' ошибка или Вы забыли её ввести"

Дата.SetFocus

ПроверкаПЛ = False

Exit Function

ElseIf Len(Деньги) = 0 Or Деньги = "0" Then

БОКС = MsgBox("Извините но в 'Строке Введите Сумму' пусто", , BOX)

Деньги.SetFocus

Деньги = ""

ПроверкаПЛ = False

Exit Function

Else

ПроверкаПЛ = True

End If

End Function

Private Function ПроверкаОБЩ() As String

If Len(Клиент) = 0 Then

БОКС = MsgBox("Извините но в Строке Наименование Клиента пусто", , BOX)

Клиент.SetFocus

ПроверкаОБЩ = False

Exit Function

ElseIf Len(Банк) = 0 Then

БОКС = MsgBox("Извините но в Строке Банк Клиента пусто", , BOX)

Банк.SetFocus

ПроверкаОБЩ = False

Exit Function

ElseIf Len(Счёт) = 0 Then

БОКС = MsgBox("Извините но в Строке Р/с Клиента пусто", , BOX)

Счёт.SetFocus

ПроверкаОБЩ = False

Exit Function

ElseIf Len(КодБанка) = 0 Then

БОКС = MsgBox("Извините но в Строке Код Банка Клиента пусто", , BOX)

КодБанка.SetFocus

ПроверкаОБЩ = False

Exit Function

Else

ПроверкаОБЩ = True

End If

End Function

Private Sub Счёт_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

If (Not (Chr(KeyAscii) Like "[0-9]")) Then KeyAscii = 0

End Sub

Private Sub Деньги_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

If (Not (Chr(KeyAscii) Like "[0-9]")) Then KeyAscii = 0

If Mid(Деньги, 1, 1) = "0" Then

Деньги = ""

Else

End If

End Sub

Private Sub КодБанка_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

If (Not (Chr(KeyAscii) Like "[0-9]")) Then KeyAscii = 0

End Sub

Private Sub УНН_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

If (Not (Chr(KeyAscii) Like "[0-9]")) Then KeyAscii = 0

End Sub

Private Sub ВидОперации_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

If (Not (Chr(KeyAscii) Like "[0-9]")) Then KeyAscii = 0

End Sub

Private Sub НомНазПл_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

If (Not (Chr(KeyAscii) Like "[0-9]")) Then KeyAscii = 0

End Sub

Private Sub НомерСТПЛ_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

If (Not (Chr(KeyAscii) Like "[0-9]")) Then KeyAscii = 0

End Sub

Private Function Впечать() As String

Sheets("Лист1").Select

If Счётчик2 = 1 Then

ActiveWorkbook.Save

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

ElseIf Счётчик2 = 2 Then

Range("A1:W28").Select

Selection.Copy

Range("A29").Select

ActiveSheet.Paste

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Rows("29:80").Select

Selection.Delete Shift:=xlUp

ActiveWorkbook.Save

ElseIf Счётчик2 = 3 Then

Range("A1:W28").Select

Selection.Copy

Range("A29").Select

ActiveSheet.Paste

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

Rows("29:80").Select

Selection.Delete Shift:=xlUp

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

ActiveWorkbook.Save

End If

End Function

Private Function Вплатёжку() As String

Windows("Платёжка.xls").Activate

Дата = Format(Дата, "Short Date")

Worksheets("Лист1").Range("D13") = Банк

Worksheets("Лист1").Range("Q11") = Счёт

Worksheets("Лист1").Range("E12") = Клиент

Worksheets("Лист1").Range("P14") = КодБанка

Worksheets("Лист1").Range("C12") = УНН

Worksheets("Лист1").Range("T7") = (Деньги & "=")

Worksheets("Лист1").Range("G4") = Format(Дата, "d mmmm yyyy")

Worksheets("Лист1").Range("L19") = ДатаУслуг

Worksheets("Лист1").Range("V19") = ВидОперации

Worksheets("Лист1").Range("B22") = НазначПлатежа1

Worksheets("Лист1").Range("O2") = НомерПл

Worksheets("Лист1").Range("V20") = НомНазПл

МестоПечати 'Функция работающая с параметрами места печати в платёжке

Worksheets("Лист1").Range("C27") = МП1

End Function

Private Function МестоПечати() As String

If МП = True Then

МП1 = "М/П"

ElseIf БП = True Then

МП1 = "Б/П"

ElseIf БезПечати = True Then

МП1 = ""

End If

End Function

Private Function МестоПечати1() As String

If Worksheets(№ПЛ).Range("M" & Счётчик) = "М/П" Then

МП = True

ElseIf Worksheets(№ПЛ).Range("M" & Счётчик) = "Б/П" Then

БП = True

ElseIf Worksheets(№ПЛ).Range("M" & Счётчик) = "" Then

БезПечати = True

End If

End Function

-----------------------

Продолжение на стр. 14

Продолжение на стр. 13

конец

Windows("Платёжки" & ГодАктивПл).Activate

Worksheets("Лист2").Range("a1") = Список

Worksheets("Лист2").Range("b" & (Y + 2)) = "Итого:"

Worksheets("Лист2").Range("c" & (Y + 2)) = Сумма

Range("A3:I" & Y + 1).Select

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

With Selection.Borders(xlEdgeLeft)

††††?????????????†††††?????††?????????????????††††????? .LineStyle =

xlContinuous

End With

With Selection.Borders(xlEdgeTop)

.LineStyle = xlContinuous

End With

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

End With

With Selection.Borders(xlEdgeRight)

.LineStyle = xlContinuous

End With

With Selection.Borders(xlInsideVertical)

.LineStyle = xlContinuous

End With

'ActiveWorkbook.Save

Range("A1").Select

Мас = Сумма & " рублей."

Просмотр.Enabled = True

Печать.Enabled = True

Счётчик.Enabled = True

Windows("Клиенты" & ГодАктивПл).Activate

Label4.Caption = "Отчёт по Получателю : " & Список _

& ", Р/С: " & Worksheets(PP).Range("c" & Список.ListIndex + 1) _

& ", Банк: " & Worksheets(PP).Range("b" & Список.ListIndex + 1) _

& ", Код Банк: " & Worksheets(PP).Range("d" & Список.ListIndex + 1) _

& " сформирован." _

& " Всего было за выбранный период " & Сумма2 & " платёжек."

Windows("Платёжки" & ГодАктивПл).Activate

X = X + 1

Loop

Сумма = Сумма + S

Сумма2 = Сумма2 + 1

Столбец

да

нет

If (R1 = Пянварь & Год) Or (R1 = Пфевраль & Год) Or (R1 = Пмарт & Год) _

Or (R1 = Папрель & Год) Or (R1 = Пмай & Год) Or (R1 = Пиюнь & Год) _

Or (R1 = Пиюль & Год) Or (R1 = Павгуст & Год) Or (R1 = Псентябрь & Год) _

Or (R1 = Поктябрь & Год) Or (R1 = Пноябрь & Год) Or (R1 = Пдекабрь & Год)

Then

Windows("Платёжки" & ГодАктивПл).Activate

N = Worksheets(PP).Cells(XX, 1)

D = Worksheets(PP).Cells(XX, 8)

S = Worksheets(PP).Cells(XX, 7)

K = Worksheets(PP).Cells(XX, 12)

R1 = Month(D) & Year(D)

Exit Do

нет

да

Len(XX) = 0

XX = dhExtractString(SS, X, ".")

Регламентиро-

ванные

запросы

нет

да

Рабочий

Лист

Excel

Рабочий

Лист

Excel

SS = Worksheets(PP).Range("L" & Список.ListIndex + 1)"

Сумм2=0, Сумма = 0, Мас = 0, x1 = 5

Активизация Лист2 в выбранном для отчёта файле.

Len(Список) = 0

нет

да

Do While Len(XX) > 0

MsgBox "Вы не выбрали ни одного месяца для отчёта"

нет

да

Отчеты

MsgBox "Вы не выбрали ни одного Получателя для отчёта"

Январь = False And Февраль = False And Март = False _

And Апрель = False And Май = False And Июнь = False _

And Июль = False And Август = False And Сентябрь = False _

And Октябрь = False And Ноябрь = False And Декабрь = False Then

НАЧАЛО

Рабочий

Лист

Excel

Ввод

и

корректировка

данных

Интерфейс

пользователя

Страницы: 1, 2