|
|
|
VBA ПлатежкаКлиент = (Worksheets(№ПЛ).Range("A" & (ComboBox1.ListIndex + 1))) КодБанка = (Worksheets(№ПЛ).Range("D" & (ComboBox1.ListIndex + 1))) УНН = (Worksheets(№ПЛ).Range("E" & (ComboBox1.ListIndex + 1))) ВидОперации = Worksheets(№ПЛ).Range("f" & (ComboBox1.ListIndex + 1)) НазначПлатежа1 = Worksheets(№ПЛ).Range("g" & (ComboBox1.ListIndex + 1)) НомНазПл = Worksheets(№ПЛ).Range("H" & (ComboBox1.ListIndex + 1)) Else Windows("Клиенты" & Year(Date)).Activate Счёт = (Worksheets(№ПЛ).Range("C" & (ComboBox1.ListIndex + 1))) Банк = (Worksheets(№ПЛ).Range("B" & (ComboBox1.ListIndex + 1))) Клиент = (Worksheets(№ПЛ).Range("A" & (ComboBox1.ListIndex + 1))) КодБанка = (Worksheets(№ПЛ).Range("D" & (ComboBox1.ListIndex + 1))) УНН = (Worksheets(№ПЛ).Range("E" & (ComboBox1.ListIndex + 1))) ВидОперации = Worksheets(№ПЛ).Range("f" & (ComboBox1.ListIndex + 1)) НазначПлатежа1 = Worksheets(№ПЛ).Range("g" & (ComboBox1.ListIndex + 1)) НомНазПл = Worksheets(№ПЛ).Range("H" & (ComboBox1.ListIndex + 1)) End If End Sub Private Sub Выход_Click() 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 UserForm_Activate() Windows("Платёжка.xls").Activate Платящий = "Текущий Плательщик : " & Worksheets("Лист1").Range("E7") & _ " УНН : " & Worksheets("Лист1").Range("C7") & _ " P/c : " & Worksheets("Лист1").Range("Q8") & _ " Банк : " & Worksheets("Лист1").Range("D8") & _ " Код Банка : " & 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 |
|
|||||||||||||||||||||||||||||
 |
|||||||||||||||||||||||||||||||
|
|||||
Рефераты бесплатно, курсовые, дипломы, научные работы, реферат бесплатно, сочинения, курсовые работы, реферат, доклады, рефераты, рефераты скачать, рефераты на тему и многое другое. |
||
При использовании материалов - ссылка на сайт обязательна. |
||
