Программа учёта поступления товаров на склад предприятия от поставщиков

If MsgBox("Удалить выбранный товар?", vbQuestion + vbYesNo) = vbYes Then

tovar_del = DataGrid1.Columns(0).CellText(DataGrid1.Bookmark)

cmd.CommandText = "DELETE FROM tovari WHERE kod_tovara=" & tovar_del

cmd.Execute

Call TovariList

Else

Exit Sub

End If

Else

a = MsgBox("Недостаточно прав для выполнения данной операции", vbExclamation + vbOKOnly)

End If

Case 3 'выход

Set rst = Nothing

Unload Me

End Select

End Sub

Private Sub Form_Load()

Call TovariList

End Sub

Private Sub txtFind_Change()

If txtFind.Text <> "" Then

rst.Filter = "name_tovara like '" & txtFind.Text & "*'"

If DataGrid1.Bookmark Then

Command1(1).Enabled = True

Command1(2).Enabled = True

Else

Command1(1).Enabled = False

Command1(2).Enabled = False

End If

Else

rst.Filter = ""

Call TovariList

End If

End Sub

Приложение 13 - Программный код файла frmNewTovar.frm

Dim rst1, rst2 As ADODB.Recordset

Private Sub CancelButton_Click()

Set rst1 = Nothing

Set rst2 = Nothing

Unload Me

End Sub

Private Sub Form_Load()

cmd.CommandText = "SELECT * FROM tovari"

Set rst1 = cmd.Execute

Set rst2 = New ADODB.Recordset

With rst2

.ActiveConnection = cnn

.CursorType = adOpenKeyset

.CursorLocation = adUseClient

.LockType = adLockPessimistic

.Source = "SELECT * FROM ed_izm"

.Open

End With

Set DataCombo1.DataSource = rst1

DataCombo1.DataField = "kod_ed"

Set DataCombo1.RowSource = rst2

DataCombo1.ListField = "name_ed"

DataCombo1.BoundColumn = "kod_ed"

End Sub

Private Sub OKButton_Click()

If Text1(0).Text <> "" Then

If Check1.Value = 1 Then

upak = "Да"

ElseIf Check1.Value = 0 Then

upak = "Нет"

End If

cmd.CommandText = "INSERT INTO tovari (name_tovara,upakovka,kod_ed) VALUES ('" & Text1(0) & "','" & upak & "','" & DataCombo1.BoundText & "')"

cmd.Execute

Call TovariList

Unload Me

Else

a = MsgBox("Не верно указаны данные", vbExclamation + vbOKOnly)

Exit Sub

End If

End Sub

Приложение 14 - Программный код файла frmEditTovar.frm

Dim rst1, rst2, rst3 As ADODB.Recordset

Private Sub CancelButton_Click()

Set rst1 = Nothing

Set rst2 = Nothing

Set rst3 = Nothing

Unload Me

End Sub

Private Sub Form_Load()

cmd.CommandText = "SELECT * FROM tovari WHERE kod_tovara=" & tovar_edit

Set rst1 = cmd.Execute

Text1(0).Text = rst1(1)

Set rst2 = New ADODB.Recordset

With rst2

.ActiveConnection = cnn

.CursorType = adOpenKeyset

.CursorLocation = adUseClient

.LockType = adLockPessimistic

.Source = "SELECT * FROM ed_izm"

.Open

End With

Set DataCombo1.DataSource = rst1

DataCombo1.DataField = "kod_ed"

Set DataCombo1.RowSource = rst2

DataCombo1.ListField = "name_ed"

DataCombo1.BoundColumn = "kod_ed"

Set rst3 = New ADODB.Recordset

rst3.ActiveConnection = cnn

rst3.Source = "SELECT * FROM ed_izm WHERE kod_ed=" & rst1(3)

rst3.Open

DataCombo1.Text = rst3(1)

If rst1(2) = "Да" Then

Check1.Value = 1

Else

Check1.Value = 0

End If

End Sub

Private Sub OKButton_Click()

If Text1(0) <> "" Then

If Check1.Value = 1 Then

upak = "Да"

ElseIf Check1.Value = 0 Then

upak = "Нет"

End If

cmd.CommandText = "UPDATE tovari SET name_tovara='" & Text1(0) & "', upakovka='" & upak & "', kod_ed='" & DataCombo1.BoundText & "' WHERE kod_tovara=" & tovar_edit

cmd.Execute

Call TovariList

Set rst1 = Nothing

Unload Me

Else

a = MsgBox("Не верно указаны данные!", vbExclamation + vbOKOnly)

Exit Sub

End If

End Sub

Приложение 15 - Программный код файла frmLogin.frm

Private Sub cmdCancel_Click()

End

End Sub

Private Sub cmdOK_Click()

'check for correct password

If txtPassword <> "" Then

pass = txtPassword

login = txtUserName

rst.Close

rst.Source = "SELECT * FROM tab1 WHERE username='" & login & "' AND password='" & pass & "'"

rst.Open

If rst.RecordCount = 0 Then

a = MsgBox("Не верное имя пользователя или пароль", vbOKOnly + vbExclamation, "Программа учёта поставок")

End

Else

If rst(3) = -1 Then user = "admin"

If rst(4) = -1 Then user = "readonly"

If rst(3) = 0 And rst(4) = 0 Then user = "default"

Unload Me

frm_MAIN.Show

Set rst = Nothing

End If

Else

MsgBox "Пароль не может быть пустым!", , "Login"

txtPassword.SetFocus

End If

End Sub

Private Sub Form_Load()

If App.PrevInstance Then End

Dim str As String

Load frm_MAIN

Set cnn = New ADODB.Connection

str = "provider=Microsoft.Jet.OLEDB.4.0; data Source=" & App.Path & "\db1.mdb"

cnn.ConnectionString = str

cnn.Open

Set cmd = New ADODB.Command

Set cmd.ActiveConnection = cnn

Set rst = New ADODB.Recordset

With rst

.ActiveConnection = cnn

.CursorType = adOpenKeyset

.CursorLocation = adUseClient

.LockType = adLockPessimistic

.Source = "tab1"

.Open

End With

If rst.RecordCount = 0 Then

user = "admin"

Unload Me

frm_MAIN.Show

Set rst = Nothing

End If

End Sub

Приложение 16 - Программный код файла frm_MAIN.frm

Dim rst As ADODB.Recordset

Private Sub mnuAboutMe_Click()

frmAbout.Show vbModal

End Sub

Private Sub mnuCalc_Click()

a = Shell("calc.exe", vbNormalFocus)

End Sub

Private Sub mnuCascade_Click()

frm_MAIN.Arrange vbCascade

End Sub

Private Sub mnuIcons_Click()

frm_MAIN.Arrange vbArrangeIcons

End Sub

Private Sub mnuDogOtch_Click()

frmDogovoriOtch.Show

End Sub

Private Sub mnuDogovori_Click()

frmDogovori.Show

End Sub

Private Sub mnuDogovoriUch_Click()

frmDogovoriUch.Show

End Sub

Private Sub mnuDop_Click()

frmZap.Show

End Sub

Private Sub mnuEd_izm_Click()

frmEd_izm.Show

End Sub

Private Sub mnuPenniOth_Click()

Set rst = New ADODB.Recordset

With rst

.ActiveConnection = cnn

.CursorType = adOpenKeyset

.CursorLocation = adUseClient

.LockType = adLockPessimistic

.Source = "SELECT uchet_postavok.nomer_dogovora, tovari.name_tovara, uchet_postavok.kol_vo, uchet_dogovorov.cena, uchet_postavok.data_prihoda, uchet_dogovorov.data_postavki, [uchet_dogovorov]![kol_vo]*[uchet_dogovorov]![cena] AS summa, (([uchet_dogovorov]![kol_vo]*[uchet_dogovorov]![cena])*0.03)*DateDiff('d',[uchet_dogovorov]![data_postavki],[uchet_postavok]![data_prihoda]) AS penni FROM tovari INNER JOIN (postavwiki INNER JOIN ((dogovora INNER JOIN uchet_dogovorov ON dogovora.nomer_dogovora=uchet_dogovorov.nomer_dogovora) INNER JOIN uchet_postavok ON dogovora.nomer_dogovora=uchet_postavok.nomer_dogovora) ON postavwiki.kod_post=dogovora.kod_post) ON (tovari.kod_tovara=uchet_postavok.kod_tovara) AND (tovari.kod_tovara=uchet_dogovorov.kod_tovara) WHERE (((uchet_postavok.data_prihoda)>[uchet_dogovorov]![data_postavki]))"

.Open

End With

Set drpPenni.DataSource = rst

drpPenni.Show

End Sub

Private Sub mnuPostavki_Click()

frmPostavki.Show

End Sub

Private Sub mnuPostavshiki_Click()

frmPostavshiki.Show

End Sub

Private Sub mnuPostOtch_Click()

frmPostOtch.Show

End Sub

Private Sub mnuTile_Click()

frm_MAIN.Arrange vbTileHorizontal

End Sub

Private Sub mnuTovari_Click()

frmTovari.Show

End Sub

Private Sub mnuUser_Click()

If user = "admin" Then

frmUsers.Show

Else

a = MsgBox("Не достаточно прав доступа.", vbOKOnly + vbInformation)

End If

End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)

Select Case Button.Index

Case 1

Call mnuTovari_Click

Case 2

Call mnuPostavshiki_Click

Case 3

Call mnuDogovoriUch_Click

Case 4

Call mnuPostavki_Click

Case 5

Call frmPosstavkiZap.Show

Case 6

Call frmDogovoraZap.Show

End Select

End Sub

Приложение 17 - Программный код файла frmDogovoraZap.frm

Dim rst, rstPost As ADODB.Recordset

Private Sub Command1_Click()

rst.Close

rst.Source = "SELECT dogovora.nomer_dogovora AS [№ договора], postavwiki.name_post AS [Наименование поставщика], tovari.name_tovara AS [Наименование товара], uchet_dogovorov.cena AS [Цена], uchet_dogovorov.kol_vo AS [Количество], uchet_dogovorov.data_postavki AS [Дата поставки] FROM tovari INNER JOIN ((postavwiki INNER JOIN dogovora ON postavwiki.kod_post = dogovora.kod_post) INNER JOIN uchet_dogovorov ON dogovora.nomer_dogovora = uchet_dogovorov.nomer_dogovora) ON tovari.kod_tovara = uchet_dogovorov.kod_tovara"

rst.Open

Set DataGrid1.DataSource = rst

End Sub

Private Sub comPostawshiki_Click()

rst.Close

rst.Source = "SELECT dogovora.nomer_dogovora AS [№ договора], postavwiki.name_post AS [Наименование поставщика], tovari.name_tovara AS [Наименование товара], uchet_dogovorov.cena AS Цена, uchet_dogovorov.kol_vo AS Количество, uchet_dogovorov.data_postavki AS [Дата поставки] FROM tovari INNER JOIN (postavwiki INNER JOIN (dogovora INNER JOIN uchet_dogovorov ON dogovora.nomer_dogovora = uchet_dogovorov.nomer_dogovora) ON postavwiki.kod_post = dogovora.kod_post) ON tovari.kod_tovara = uchet_dogovorov.kod_tovara WHERE (((postavwiki.name_post)='" & comPostawshiki.Text & "'))"

rst.Open

Set DataGrid1.DataSource = rst

End Sub

Private Sub Form_Load()

Set rst = New ADODB.Recordset

Set rstPost = New ADODB.Recordset

With rst

.ActiveConnection = cnn

.CursorType = adOpenKeyset

.CursorLocation = adUseClient

.LockType = adLockPessimistic

.Source = "SELECT dogovora.nomer_dogovora AS [№ договора], postavwiki.name_post AS [Наименование поставщика], tovari.name_tovara AS [Наименование товара], uchet_dogovorov.cena AS [Цена], uchet_dogovorov.kol_vo AS [Количество], uchet_dogovorov.data_postavki AS [Дата поставки] FROM tovari INNER JOIN ((postavwiki INNER JOIN dogovora ON postavwiki.kod_post = dogovora.kod_post) INNER JOIN uchet_dogovorov ON dogovora.nomer_dogovora = uchet_dogovorov.nomer_dogovora) ON tovari.kod_tovara = uchet_dogovorov.kod_tovara"

.Open

End With

With rstPost

.ActiveConnection = cnn

.CursorType = adOpenKeyset

.CursorLocation = adUseClient

.LockType = adLockPessimistic

.Source = "postavwiki"

.Open

End With

Set DataGrid1.DataSource = rst

DataGrid1.Width = Me.Width

Me.Height = 7890

While rstPost.EOF = False

comPostawshiki.AddItem (rstPost(1))

rstPost.MoveNext

Wend

End Sub

Private Sub Form_Unload(Cancel As Integer)

Set rst = Nothing

Set rstPost = Nothing

End

Sub

Приложение 18 - Программный код файла frmPostOtch.frm

Dim rst As ADODB.Recordset

Private Sub Command1_Click()

rst.Close

date1 = DTPicker1(0).Month & "/" & DTPicker1(0).Day & "/" & DTPicker1(0).Year

date2 = DTPicker1(1).Month & "/" & DTPicker1(1).Day & "/" & DTPicker1(1).Year

If Option1(2).Value = True Then rst.Source = "SELECT uchet_postavok.nomer_dogovora, tovari.name_tovara, uchet_postavok.kol_vo, uchet_dogovorov.cena, uchet_postavok.data_prihoda FROM tovari INNER JOIN (postavwiki INNER JOIN ((dogovora INNER JOIN uchet_dogovorov ON dogovora.nomer_dogovora = uchet_dogovorov.nomer_dogovora) INNER JOIN uchet_postavok ON dogovora.nomer_dogovora = uchet_postavok.nomer_dogovora) ON postavwiki.kod_post = dogovora.kod_post) ON (tovari.kod_tovara = uchet_postavok.kod_tovara) AND (tovari.kod_tovara = uchet_dogovorov.kod_tovara) WHERE (((uchet_postavok.data_prihoda)<=[uchet_dogovorov]![data_postavki] And (uchet_postavok.data_prihoda) Between #" & date1 & "# And #" & date2 & "#))"

If Option1(0).Value = True Then rst.Source = "SELECT uchet_postavok.nomer_dogovora, tovari.name_tovara, uchet_postavok.kol_vo, uchet_dogovorov.cena, uchet_postavok.data_prihoda FROM tovari INNER JOIN (postavwiki INNER JOIN ((dogovora INNER JOIN uchet_dogovorov ON dogovora.nomer_dogovora = uchet_dogovorov.nomer_dogovora) INNER JOIN uchet_postavok ON dogovora.nomer_dogovora = uchet_postavok.nomer_dogovora) ON postavwiki.kod_post = dogovora.kod_post) ON (tovari.kod_tovara = uchet_postavok.kod_tovara) AND (tovari.kod_tovara = uchet_dogovorov.kod_tovara) WHERE ((uchet_postavok.data_prihoda) Between #" & date1 & "# And #" & date2 & "#)"

If Option1(1).Value = True Then rst.Source = "SELECT uchet_postavok.nomer_dogovora, tovari.name_tovara, uchet_postavok.kol_vo, uchet_dogovorov.cena, uchet_postavok.data_prihoda FROM tovari INNER JOIN (postavwiki INNER JOIN ((dogovora INNER JOIN uchet_dogovorov ON dogovora.nomer_dogovora = uchet_dogovorov.nomer_dogovora) INNER JOIN uchet_postavok ON dogovora.nomer_dogovora = uchet_postavok.nomer_dogovora) ON postavwiki.kod_post = dogovora.kod_post) ON (tovari.kod_tovara = uchet_postavok.kod_tovara) AND (tovari.kod_tovara = uchet_dogovorov.kod_tovara) WHERE (((uchet_postavok.data_prihoda)>[uchet_dogovorov]![data_postavki] And (uchet_postavok.data_prihoda) Between #" & date1 & "# And #" & date2 & "#))"

rst.Open

Set drpPostavki.DataSource = rst

drpPostavki.Show

drpPostavki.Refresh

End Sub

Private Sub Command2_Click()

Set rst = Nothing

Unload Me

End Sub

Private Sub Form_Load()

Set rst = New ADODB.Recordset

With rst

.ActiveConnection = cnn

.CursorType = adOpenKeyset

.CursorLocation = adUseClient

.LockType = adLockPessimistic

.Source = "SELECT * FROM uchet_postavok"

.Open

End With

End Sub

Приложение 19 - Программный код файла frmDogovoriOtch.frm

Dim rst As ADODB.Recordset

Private Sub Command1_Click()

rst.Close

If Option1(0).Value = True Then rst.Source = "SELECT uchet_dogovorov.nomer_dogovora, zap.[Sum-kol_vo], zap.name_tovara, uchet_dogovorov.kol_vo FROM uchet_dogovorov INNER JOIN zap ON uchet_dogovorov.nomer_dogovora = zap.nomer_dogovora GROUP BY uchet_dogovorov.nomer_dogovora, zap.[Sum-kol_vo], zap.name_tovara, uchet_dogovorov.kol_vo HAVING (((zap.[Sum-kol_vo])=[uchet_dogovorov]![kol_vo]))"

If Option1(1).Value = True Then rst.Source = "SELECT uchet_dogovorov.nomer_dogovora, zap.[Sum-kol_vo], zap.name_tovara, uchet_dogovorov.kol_vo FROM uchet_dogovorov INNER JOIN zap ON uchet_dogovorov.nomer_dogovora = zap.nomer_dogovora GROUP BY uchet_dogovorov.nomer_dogovora, zap.[Sum-kol_vo], zap.name_tovara, uchet_dogovorov.kol_vo HAVING (((zap.[Sum-kol_vo])<[uchet_dogovorov]![kol_vo]))"

rst.Open

Set drpDogovora.DataSource = rst

drpDogovora.Show

drpDogovora.Refresh

End Sub

Private Sub Command2_Click()

Set rst = Nothing

Unload Me

End Sub

Private Sub Form_Load()

Set rst = New ADODB.Recordset

With rst

.ActiveConnection = cnn

.CursorType = adOpenKeyset

.CursorLocation = adUseClient

.LockType = adLockPessimistic

.Source = "SELECT * FROM uchet_postavok"

.Open

End With

End Sub

Приложение 19 - Программный код файла frmUsers.frm

Private Sub Command1_Click()

Unload Me

End Sub

Private Sub Command2_Click() 'добавить

If user = "admin" Then

frmNewUser.Show vbModal

Else

a = MsgBox("Недостаточно прав для выполнения данной операции", vbExclamation + vbOKOnly)

End If

End Sub

Private Sub Command3_Click() 'удалить

If user = "admin" Then

If MSFlexGrid1.Text <> "" And MSFlexGrid1.Text <> "Имя пользователя" Then

If MsgBox("Удалить пользователя " & MSFlexGrid1.Text & "?", vbQuestion + vbYesNo) = vbYes Then

cmd.CommandText = "DELETE FROM tab1 WHERE username='" & MSFlexGrid1.Text & "'"

cmd.Execute

MSFlexGrid1.Rows = 1

MSFlexGrid1.Cols = 2

Call usersList

Else

Exit Sub

End If

End If

Else

a = MsgBox("Недостаточно прав для выполнения данной операции", vbExclamation + vbOKOnly)

End If

End Sub

Private Sub Form_Load()

Set rstUsers = New ADODB.Recordset

With rstUsers

.ActiveConnection = cnn

.CursorType = adOpenKeyset

.CursorLocation = adUseClient

.LockType = adLockPessimistic

End With

Call usersList

End Sub

СПИСОК ИСПОЛЬЗУЕМЫХ СОКРАЩЕНИЙ

1. ПК - персональный компьютер.

2. OC - операционная система.

3. ЭВМ - электронно-вычислительная машина.

4. ПО - программное обеспечение.

5. СУБД - система управления базами данных.

6. СПИСОК ЛИТЕРАТУРЫ

1. А. Ананьев, А. Федоров «Visual Basic 6.0» Санкт-Петербург «БХВ-Петербург» 2003г.

2. Валерий Алиев «Visual Basic».

3. Правила приема в Санкт-Петербургский промышленно-экономический колледж.

4. Микаэл Хальворсон. Microsoft Visual Basic 6.0 для профессионалов. Шаг за шагом: Издательство ЭКОМ, 2002.

5. Борис Карпов. Visual Basic 6. Специальный справочник: Издательство ПИТЕР, 2002

6. Элен Фаддема. Access 2002. Издательство ПИТЕР, 2003

Размещено на Allbest