Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Звіт.doc
Скачиваний:
7
Добавлен:
22.11.2018
Размер:
657.41 Кб
Скачать

Кнопка "Відмінити"

Private Sub vidminyty_Click()

Поля

nomerpp.Text = ActiveCell.Value

datazam.Text = ActiveCell.Offset(0, 1).Value

prizv.Text = ActiveCell.Offset(0, 2).Value

nazvmist.Text = ActiveCell.Offset(0, 3).Value

kld.Text = ActiveCell.Offset(0, 4).Value

sezon.Text = ActiveCell.Offset(0, 5).Value

klp.Text = ActiveCell.Offset(0, 6).Value

vidput.Text = ActiveCell.Offset(0, 7).Value

vart.Text = ActiveCell.Offset(0, 8).Value

ostvart.Text = ActiveCell.Offset(0, 9).Value

Доступ до полів

nomerpp.Locked = True

datazam.Locked = True

prizv.Locked = True

nazvmist.Locked = True

kld.Locked = True

sezon.Locked = True

klp.Locked = True

vidput.Locked = True

vart.Locked = True

ostvart.Locked = True

Активність кнопок

nastup.Enabled = a1

popered.Enabled = a2

dopovnyty.Enabled = True

redag.Enabled = True

vihid.Enabled = True

dopovnyty.SetFocus

zberegty.Enabled = False

vidminyty.Enabled = False

End Sub

Кнопка "Вихід"

Private Sub Vihid_Click()

Аналіз коректності виходу”

If MsgBox("Підтвердіть вихід із форми користувача", vbYesNo, "Вікно запиту") = vbYes Then

Unload Turist

End If

Кнопка "Видалити"

Private Sub vidal_Click()

Умова”

If MsgBox("Ви бажаєте видалити запис?", vbYesNo, "Видалення") = vbYes Then

Range(Cells(ActivCell.row, ActiveCell.Column), Cells(ActiveCells.row, ActiveCell.Column + 32)).Select

Selection.Delete Shift:=xlUp

If ActiveCell.Text = "" Then

ActiveCell.Offset(-1, 0).Select

End If

Поля”

Range("L4").Select

nomerpp.Text = ActiveCell.Value

datazam.Text = ActiveCell.Offset(0, 1).Value

prizv.Text = ActiveCell.Offset(0, 2).Value

nazvmist.Text = ActiveCell.Offset(0, 3).Value

kld.Text = ActiveCell.Offset(0, 4).Value

sezon.Text = ActiveCell.Offset(0, 5).Value

klp.Text = ActiveCell.Offset(0, 6).Value

vidput.Text = ActiveCell.Offset(0, 7).Value

vart.Text = ActiveCell.Offset(0, 8).Value

ostvart.Text = ActiveCell.Offset(0, 9).Value

End If

End Sub

Кнопка "Архівація"

Кнопка призначена для збереження копії оригінального файлу у директорії оригінального файлу.

Private Sub archiv_Click()

Поля”

Const PROJECT_NAME = "Work_Shevchenko"

On Error Resume Next: ThisWorkbook.Save

Створення директорії

BackupsPath = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, PROJECT_NAME & " Файли архівації\")

MkDir BackupsPath

ext$ = Split(ThisWorkbook.Name, ".")(UBound(Split(ThisWorkbook.Name, ".")))

FileNameXls = BackupsPath & PROJECT_NAME & "_BACKUP_" & Format(Now, "DD-MM-YYYY__HH-NN-SS") & "." & ext$

Копіювання файлу у директорію

ThisWorkbook.SaveCopyAs FileNameXls

If PROJECT_NAME = " Файли архівації/ Then

MsgBox "Файл знаходится у директорії оригінального файлу"

End If

End Sub

Кнопка "Конвертація валют"

Private Sub kurs_Click()

Кнопка призначена для переходу на форму для конвертація валют

Поля”

Sheets("Курс валют").Select

Val.Show

End Sub

Кнопка "Сортування"

Private Sub sort_Click()

Поля”

Range("L4").Select

Цикл з умовою

Do While ActiveCell.Offset(1, 0).Value <> ""

ActiveCell.Offset(1, 0).Select

Loop

d = ActiveCell.row

e = "L4:Z" + LTrim(Str(d))

If np.Value = True Then r = "L4"

If pr = True Then r = "N4"

If sz = True Then r = "Q4"

If vp = True Then r = "S4"

If nm = True Then r = "O4"

Range(e).sort Key1:=Range(r), Order1:=xlAscending, Header:= _

xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

DataOption1:=xlSortNormal

End Sub