Студопедия — РАСПЕЧАТКА ПРОГРАММЫ
Студопедия Главная Случайная страница Обратная связь

Разделы: Автомобили Астрономия Биология География Дом и сад Другие языки Другое Информатика История Культура Литература Логика Математика Медицина Металлургия Механика Образование Охрана труда Педагогика Политика Право Психология Религия Риторика Социология Спорт Строительство Технология Туризм Физика Философия Финансы Химия Черчение Экология Экономика Электроника

РАСПЕЧАТКА ПРОГРАММЫ






'---------------------------------------------------------------

'Код для модуля меню

'-------------------------------------------------------------------------------------------------------------------

Sub SetupMenu()

With Worksheets("Сп.заказов")

.Activate

.Rows("2:2").Select

ActiveWindow.FreezePanes = True

End With

Range("A1:L1").Select

With Selection

.Font.Bold = True

.HorizontalAlignment = xlHAlignCenter

.VerticalAlignment = xlVAlignBottom

With.Interior

.ColorIndex = 36

.Pattern = xlSolid

End With

End With

Range("A1").Select

With Application

.DisplayFormulaBar = False

.DisplayStatusBar = False

.CommandBars("Formatting").Visible = False

.CommandBars("Standard").Visible = False

End With

With ActiveWindow

.DisplayVerticalScrollBar = True

.DisplayHorizontalScrollBar = False

End With

MenuBars(xlWorksheet).Menus.Add Caption:="&База", before:=9

MenuBars(xlWorksheet).Menus("&База").MenuItems.Add _

Caption:="&Выход", before:=1, OnAction:="Quit"

MenuBars(xlWorksheet).Menus("&База").MenuItems.Add _

Caption:="&Сохранение", before:=1, OnAction:="SaveBd"

MenuBars(xlWorksheet).Menus("&База").MenuItems.Add _

Caption:="Р&едактирование", before:=1, OnAction:="StartRedact"

MenuBars(xlWorksheet).Menus("&База").MenuItems.Add _

Caption:="&Регистрация", before:=1, OnAction:="StartRegister"

MenuBars(xlWorksheet).Menus("&База").MenuItems.Add _

Caption:="&Меню", before:=1, OnAction:="Ret"

End Sub

 

Sub DeleteMenus()

With Application

.DisplayFormulaBar = True

.DisplayStatusBar = True

.CommandBars("Formatting").Visible = True

.CommandBars("Standard").Visible = True

End With

With ActiveWindow

.DisplayHorizontalScrollBar = True

End With

For Each MenuName In MenuBars(xlWorksheet).Menus

If MenuName.Caption = "&База" Then

MenuName.Delete

End If

Next

End Sub

 

'---------------------------------------------------------------

'Код для основных действий программы

'-------------------------------------------------------------------------------------------------------------------

'Регистрация нового заказа

 

Sub StartRegister()

Worksheets("Фон").Activate

NewTur = True

With frmData

With.cmdv1

.Visible = True

.Default = True

.ControlTipText = "Занести новый заказ"

End With

 

With.cmdv2

.Visible = True

.Default = True

.ControlTipText = "Выйти в главное меню"

End With

 

.cmdf1.Visible = False

.cmdf2.Visible = False

.Caption = "Регистрация заказа"

ClearForm

.Show

End With

End Sub

 

'Редактирование заказа

 

Sub StartRedact()

Worksheets("Фон").Activate

NewTur = False

With frmData

With.cmdv1

.Visible = True

.Default = True

.ControlTipText = "Изменить старый заказ"

End With

With.cmdv2

.Visible = True

.Default = True

.ControlTipText = "Выйти в главное меню"

End With

.cmdf1.Visible = True

.cmdf2.Visible = True

.Caption = "Редактирование заказа"

.cmdf1.ControlTipText = "Найти заказ"

.cmdf2.ControlTipText = "Удалить из базы"

If FoundRow = 0 Then frmFind.Show Else.Show

End With

End Sub

 

Sub Quit()

Dim sav As Integer

If ActiveWorkbook.Saved = False Then

sav = MsgBox("Сохранить документ?", vbYesNoCancel, "БД")

If sav = vbCancel Then Exit Sub

If sav = vbYes Then

DeleteMenus

ActiveWorkbook.Close True

Else

DeleteMenus

ActiveWorkbook.Close False

End If

End If

DeleteMenus

ActiveWorkbook.Close False

End Sub

'очистка формы

 

Sub ClearForm()

Dim i As Integer

With frmData

.txt1 = ""

.txt2 = ""

.txt3 = ""

.txt4 = ""

.txt5 = ""

.txt6 = ""

.txt7 = ""

.txt8 = ""

.txt9 = ""

.comb1 = ""

.comb1.Clear

.comb1.AddItem "ж\д", 0

.comb1.AddItem "авиа", 1

.comb1.AddItem "судоход", 2

.comb1.AddItem "грузовики", 3

.comb1.AddItem "не важно", 4

.comb1.Text =.comb1.List(0)

.chb1.Value = 0

.chb2.Value = 0

.chb3.Value = 0

.chb4.Value = 0

.chb5.Value = 0

.chb6.Value = 0

End With

End Sub

'Добавление заказа в таблицу

 

Sub AddZak()

Dim Range As Object

Dim NewRow As Integer

Dim i As Integer

Set Range = Worksheets("Сп.заказов").Cells(1, 1).CurrentRegion

With frmData

Data(1) =.txt1.Text

Data(2) =.txt2.Text

Data(3) =.txt3.Text

Data(4) =.txt4.Text

Data(6) =.txt5.Text

Data(7) =.txt6.Text

Data(8) =.txt7.Text

Data(9) =.txt9.Text

Data(10) =.comb1.Text

If.pro.Value = True Then

Data(12) = "Предоплата"

Else

Data(12) = "Аккредитив"

End If

If.pok.Value = True Then

Data(13) = "Покупка"

Else

Data(13) = "Продажа"

End If

If.chb1.Value = True Then

Data(14) = "Да"

Else

Data(14) = "Нет"

End If

If.chb2.Value = True Then

Data(15) = "Да"

Else

Data(15) = "Нет"

End If

If.chb3.Value = True Then

Data(16) = "Да"

Else

Data(16) = "Нет"

End If

If.chb4.Value = True Then

Data(17) = "Да"

Else

Data(17) = "Нет"

End If

If.chb5.Value = True Then

Data(18) = "Да"

Else

Data(18) = "Нет"

End If

If.chb6.Value = True Then

Data(19) = "Да"

Else

Data(19) = "Нет"

End If

End With

NewRow = Range.Rows.Count + 1

For i = 1 To 13

With Worksheets("Сп.заказов")

.Cells(NewRow, i).Value = Data(i)

End With

Next i

FoundRow = NewRow

End Sub

 

'Поиск заказа

 

Sub FindZak()

Dim RowRng As Object

Dim NameCl As Variant

Dim Zakaz, Tovar As Variant

Dim Row, i As Integer

Set RowRng = Worksheets("Сп.заказов").Cells(1, 1).CurrentRegion

With frmFind

Zakaz =.ComboBox1.Text

Tovar =.ComboBox2.Text

.ComboBox1.Text = ""

.ComboBox2.Text = ""

End With

Row = RowRng.Rows.Count

With Worksheets("Сп.заказов")

For i = 2 To Row

If Zakaz =.Cells(i, 1).Value And Tovar =.Cells(i, 6).Value Then

FoundRow = i

frmFind.Hide

MsgBox "Нашли заказ.." & Chr(10) & "Редактируем!", vbOKOnly + vbInformation, "Есть заказ"

frmData.Show

Exit Sub

End If

Next i

End With

MsgBox "Нет такого заказа в базе" & Chr(10) & "Повторите поиск", vbOKOnly + vbInformation

End Sub

'Редактирование найденного заказа

 

Sub EditZak()

Dim Row, i As Integer

Row = FoundRow

With frmData

For i = 1 To 13

Data(i) = Worksheets("Сп.заказов").Cells(Row, i).Value

Next i

Data(1) =.txt1.Text

Data(2) =.txt2.Text

Data(3) =.txt3.Text

Data(4) =.txt4.Text

Data(6) =.txt5.Text

Data(7) =.txt6.Text

Data(8) =.txt7.Text

Data(9) =.txt9.Text

Data(10) =.comb1.Text

If.pro.Value = True Then

Data(12) = "Предоплата"

Else

Data(12) = "Аккредитив"

End If

If.pok.Value = True Then

Data(13) = "Покупка"

Else

Data(13) = "Продажа"

End If

If.chb1.Value = True Then

Data(14) = "Да"

Else

Data(14) = "Нет"

End If

If.chb2.Value = True Then

Data(15) = "Да"

Else

Data(15) = "Нет"

End If

If.chb3.Value = True Then

Data(16) = "Да"

Else

Data(16) = "Нет"

End If

If.chb4.Value = True Then

Data(17) = "Да"

Else

Data(17) = "Нет"

End If

If.chb5.Value = True Then

Data(18) = "Да"

Else

Data(18) = "Нет"

End If

If.chb6.Value = True Then

Data(19) = "Да"

Else

Data(19) = "Нет"

End If

End With

End Sub

 

'Удаление найденного заказа

 

Sub DeleteZak()

Dim temp As Integer

temp = MsgBox("Точно точно удалить???", vbYesNoCancel, "Удаление")

If temp = vbCancel Then

frmData.Hide

frmStart.Show

End If

If temp = vbYes Then

Dim Range As Object

Dim LastRow, i, j As Integer

With Worksheets("Сп.заказов")

Set Range =.Cells(1, 1).CurrentRegion

LastRow = Range.Rows.Count + 1

For i = FoundRow + 1 To LastRow

For j = 1 To 13

.Cells(i - 1, j).Value =.Cells(i, j).Value

Next j

Next i

End With

ClearForm

FoundRow = 0

frmData.Hide

MsgBox "Данные удалены!"

frmStart.Show

End If

End Sub

 

 







Дата добавления: 2015-10-01; просмотров: 294. Нарушение авторских прав; Мы поможем в написании вашей работы!



Функция спроса населения на данный товар Функция спроса населения на данный товар: Qd=7-Р. Функция предложения: Qs= -5+2Р,где...

Аальтернативная стоимость. Кривая производственных возможностей В экономике Буридании есть 100 ед. труда с производительностью 4 м ткани или 2 кг мяса...

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

Расчетные и графические задания Равновесный объем - это объем, определяемый равенством спроса и предложения...

Измерение следующих дефектов: ползун, выщербина, неравномерный прокат, равномерный прокат, кольцевая выработка, откол обода колеса, тонкий гребень, протёртость средней части оси Величину проката определяют с помощью вертикального движка 2 сухаря 3 шаблона 1 по кругу катания...

Неисправности автосцепки, с которыми запрещается постановка вагонов в поезд. Причины саморасцепов ЗАПРЕЩАЕТСЯ: постановка в поезда и следование в них вагонов, у которых автосцепное устройство имеет хотя бы одну из следующих неисправностей: - трещину в корпусе автосцепки, излом деталей механизма...

Понятие метода в психологии. Классификация методов психологии и их характеристика Метод – это путь, способ познания, посредством которого познается предмет науки (С...

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

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

Виды сухожильных швов После выделения культи сухожилия и эвакуации гематомы приступают к восстановлению целостности сухожилия...

Studopedia.info - Студопедия - 2014-2024 год . (0.013 сек.) русская версия | украинская версия