VBA Платежка
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, 3
|