Разработка программного обеспечения для складского учета

Set FmZ.DataGrid2.DataSource = DE

FmZ.DataGrid2.Refresh

End Sub

Private Sub Form_Load()

DataGrid1.Columns("Cl_Z_Men").Visible = False

DataGrid1.Columns("Cl_Z_Client").Visible = False

DataGrid1.Columns("Cl_Z_Tovar").Visible = False

DataGrid1.Columns("Cl_Z_Znum").Visible = False

DataGrid2.Columns("Tovar_name").Visible = False

End Sub

Код модуля FmZCont

Private cn As ADODB.Connection

Private rs As ADODB.Recordset

Private rsTovar As ADODB.Recordset

Private Sub CBTovar_Click(Area As Integer)

If CBTovar.Text <> "" Then

cmd = "Provider = MSDAORA;" & _

"Data Source = " & oracle.world & "\ User Id=4208; Password=4208;Persist Security Info=False"

'MsgBox cmd

Set cn = New ADODB.Connection

With cn

.ConnectionString = cmd

.Open

End With

SQL = "SELECT * FROM Tovar WHERE idTovar = " & CBTovar.BoundText

Set rs = New ADODB.Recordset

With rs

.Open SQL, cn, adOpenForwardOnly, adLockReadOnly

End With

TextCost.Text = rs("Tovar_price")

End If

End Sub

Private Sub RefreshData()

DE.rsComPZ.Close

DE.rsComPZ.Open

DE.rsComPZ.Fields(13).Value.Close

Set FmZ.DataGrid1.DataSource = DE

Set FmZ.DataGrid2.DataSource = DE

FmZ.DataGrid2.Refresh

End Sub

Private Sub Command1_Click()

'MsgBox idRaschod

If idRaschod = 0 Then ' Добавлние записи

If TextCost.Text = "0" Then

MsgBox "Вы не выбрали товар или цена товара равна нулю"

Exit Sub

End If

If TextQuan.Text = "" Or TextQuan.Text = "0" Then

MsgBox "Количетсво товара не может быть пустым или нулевым значением"

Exit Sub

End If

cmd = "Provider = MSDAORA;" & _

"Data Source = " & oracle.world & "\ User Id=4208; Password=4208;Persist Security Info=False"

'MsgBox cmd

Set cn = New ADODB.Connection

With cn

.ConnectionString = cmd

.Open

End With

'DE.rsComRas.Close

' DE.rsComRas.Open

'Запрос на вставку данных

'MsgBox idCl_Z

Dim x As Integer

x = CInt(idCl_Z)

'MsgBox (x)

SQL = "Insert INTO Raschod (idCl_Z, Raschod_Tovar, Raschod_Price, Raschod_quan) VALUES (" & x & ", " & CBTovar.BoundText & "," & TextCost.Text & "," & TextQuan.Text & ")"

'MsgBox SQL

Set rs = New ADODB.Recordset

With rs

.Open SQL, cn, adOpenForwardOnly, adLockReadOnly

End With

'rs.Close

Set rs = Nothing

cn.Close

Set cn = Nothing

End If

If idRaschod <> 0 Then 'Редактирование записи

If TextCost.Text = "0" Then

MsgBox "Вы не выбрали товар или цена товара равна нулю"

Exit Sub

End If

If TextQuan.Text = "" Or TextQuan.Text = "0" Then

MsgBox "Количетсво товара не может быть пустым или нулевым значением"

Exit Sub

End If

'MsgBox "!!"

cmd = "Provider = MSDAORA;" & _

"Data Source = " & oracle.world & "\ User Id=4208; Password=4208;Persist Security Info=False"

'MsgBox cmd

Set cn = New ADODB.Connection

With cn

.ConnectionString = cmd

.Open

End With

'Запрос на обновление данных

SQL = "UPDATE Raschod SET idCl_Z = " & idCl_Z & ", Raschod_Tovar = " & CBTovar.BoundText & ", Raschod_Price = " & TextCost.Text & ", Raschod_quan = " & TextQuan.Text & " WHERE idRaschod = " & idRaschod

'MsgBox SQL

'MsgBox SQL

Set rs = New ADODB.Recordset

With rs

.Open SQL, cn, adOpenForwardOnly, adLockReadOnly

End With

' rs.Close

Set rs = Nothing

cn.Close

Set cn = Nothing

End If

DE.rsComPZ.Close

DE.rsComPZ.Open

Set FmZ.DataGrid1.DataSource = DE

Set FmZ.DataGrid2.DataSource = DE

FmZ.DataGrid2.Refresh

FmZCont.Hide

Call RefreshData

End Sub

Private Sub Command2_Click()

FmZCont.Hide

End Sub

Код модуля FmPrihod

Private cn As ADODB.Connection

Private rs As ADODB.Recordset

Private rsTovar As ADODB.Recordset

Private Sub CBTovar_Click(Area As Integer)

If CBTovar.Text <> "" Then

cmd = "Provider = MSDAORA;" & _

"Data Source = " & oracle.world & "\ User Id=4208; Password=4208;Persist Security Info=False"

'MsgBox cmd

Set cn = New ADODB.Connection

With cn

.ConnectionString = cmd

.Open

End With

SQL = "SELECT * FROM Tovar WHERE idTovar = " & CBTovar.BoundText

Set rs = New ADODB.Recordset

With rs

.Open SQL, cn, adOpenForwardOnly, adLockReadOnly

End With

TextCost.Text = rs("Tovar_price")

End If

End Sub

Private Sub RefreshData()

DE.rsComPZ.Close

DE.rsComPZ.Open

DE.rsComPZ.Fields(13).Value.Close

Set FmZ.DataGrid1.DataSource = DE

Set FmZ.DataGrid2.DataSource = DE

FmZ.DataGrid2.Refresh

End Sub

Private Sub Command1_Click()

'MsgBox idRaschod

If idRaschod = 0 Then ' Добавлние записи

If TextCost.Text = "0" Then

MsgBox "Вы не выбрали товар или цена товара равна нулю"

Exit Sub

End If

If TextQuan.Text = "" Or TextQuan.Text = "0" Then

MsgBox "Количетсво товара не может быть пустым или нулевым значением"

Exit Sub

End If

cmd = "Provider = MSDAORA;" & _

"Data Source = " & oracle.world & "\ User Id=4208; Password=4208;Persist Security Info=False"

'MsgBox cmd

Set cn = New ADODB.Connection

With cn

.ConnectionString = cmd

.Open

End With

'DE.rsComRas.Close

' DE.rsComRas.Open

'Запрос на вставку данных

'MsgBox idCl_Z

Dim x As Integer

x = CInt(idCl_Z)

'MsgBox (x)

SQL = "Insert INTO Raschod (idCl_Z, Raschod_Tovar, Raschod_Price, Raschod_quan) VALUES (" & x & ", " & CBTovar.BoundText & "," & TextCost.Text & "," & TextQuan.Text & ")"

'MsgBox SQL

Set rs = New ADODB.Recordset

With rs

.Open SQL, cn, adOpenForwardOnly, adLockReadOnly

End With

'rs.Close

Set rs = Nothing

cn.Close

Set cn = Nothing

End If

If idRaschod <> 0 Then 'Редактирование записи

If TextCost.Text = "0" Then

MsgBox "Вы не выбрали товар или цена товара равна нулю"

Exit Sub

End If

If TextQuan.Text = "" Or TextQuan.Text = "0" Then

MsgBox "Количетсво товара не может быть пустым или нулевым значением"

Exit Sub

End If

'MsgBox "!!"

cmd = "Provider = MSDAORA;" & _

"Data Source = " & oracle.world & "\ User Id=4208; Password=4208;Persist Security Info=False"

'MsgBox cmd

Set cn = New ADODB.Connection

With cn

.ConnectionString = cmd

.Open

End With

'Запрос на обновление данных

SQL = "UPDATE Raschod SET idCl_Z = " & idCl_Z & ", Raschod_Tovar = " & CBTovar.BoundText & ", Raschod_Price = " & TextCost.Text & ", Raschod_quan = " & TextQuan.Text & " WHERE idRaschod = " & idRaschod

'MsgBox SQL

'MsgBox SQL

Set rs = New ADODB.Recordset

With rs

.Open SQL, cn, adOpenForwardOnly, adLockReadOnly

End With

' rs.Close

Set rs = Nothing

cn.Close

Set cn = Nothing

End If

DE.rsComPZ.Close

DE.rsComPZ.Open

Set FmZ.DataGrid1.DataSource = DE

Set FmZ.DataGrid2.DataSource = DE

FmZ.DataGrid2.Refresh

FmZCont.Hide

Call RefreshData

End Sub

Private Sub Command2_Click()

FmZCont.Hide

End Sub

Код модуля FmSpisanie

Private Sub UpdateData()

DE.rsComSpis.Close

DE.rsComSpis.Open

End Sub

Private Sub UpdateElems()

Set DataGrid1.DataSource = DE

Set DataGrid2.DataSource = DE

Set TextDate.DataSource = DE

Set TextQuan.DataSource = DE

Set TextReason.DataSource = DE

End Sub

Private Sub Command1_Click()

TextDate.Enabled = True

TextQuan.Enabled = True

TextReason.Enabled = True

'TextDate.Enabled = True

DE.rsComSpis.AddNew

Command1.Enabled = False

Command3.Enabled = False

Command2.Enabled = True

Call UpdateElems

End Sub

Private Sub Command2_Click()

'Проверка что в поле число

If Command1.Enabled = False Then

If IsNumeric(TextQuan.Text) Then

If DE.rsComTov!Tovar_quan - TextQuan.Text < 0 Then

MsgBox "Требуемое для списания количество товара отсутствует"

Exit Sub

End If

Else

MsgBox "Введенное количество не является числом"

Exit Sub

End If

If TextDate.Text = "" Or _

TextQuan.Text = "" Or _

TextReason.Text = "" Then

MsgBox "Не все данные введены"

Exit Sub

End If

DE.rsComSpis!spis_tovar = DE.rsComTov!idTovar

DE.rsComSpis.Update

DE.rsComTov!Tovar_quan = DE.rsComTov!Tovar_quan - TextQuan.Text

Command1.Enabled = True

Command3.Enabled = True

UpdateData

UpdateElems

End If

TextDate.Enabled = False

TextQuan.Enabled = False

TextReason.Enabled = False

End Sub

Private Sub Command3_Click()

DE.rsComTov!Tovar_quan = DE.rsComTov!Tovar_quan + DE.rsComSpis!spis_quan

DE.rsComSpis.Delete

UpdateData

UpdateElems

End Sub

Private Sub Command4_Click()

DE.rsComSpis.CancelUpdate

Command2.Enabled = False

Command1.Enabled = True

Command3.Enabled = True

End Sub

Private Sub Command5_Click()

DE.rsComTov.Filter = "idTovar = " & DE.rsComTov!idTovar

RepSpis.Show

End Sub

Private Sub Command6_Click()

Set objExcel = CreateObject("Excel.Application")

objExcel.Workbooks.Open FileName:=CurDir & "\history.xlt"

With DE

'Шапка счета:

objExcel.Cells(3, 2) = Format$(.rsComTov!idTovar, "0")

objExcel.Cells(3, 4) = Format$(.rsComTov!Tovar_num, "0000")

objExcel.Cells(4, 2) =.rsComTov!Tovar_name

objExcel.Cells(6, 2) =.rsComTov!Tovar_note

Dim rst As New ADODB.Recordset

'ComRTovar.Open

Set rst =.rsComSpis

'Экспорт в таблицу состава счета:

'rst.Open

rst.MoveFirst

i = 0

PosInc = 9

Do Until rst.EOF

'Добавление новой строки:

If i <> 0 Then

objExcel.Rows.Item(PosInc + i).Select

objExcel.Selection.Insert

objExcel.Rows.Item(PosInc).Select

objExcel.Selection.Copy

objExcel.Rows.Item(PosInc + i).Select

objExcel.ActiveSheet.Paste

objExcel.Application.CutCopyMode = False

End If

objExcel.Cells(i + PosInc, 1) = i + 1

objExcel.Cells(i + PosInc, 2) = rst!spis_date

objExcel.Cells(i + PosInc, 3) = rst!spis_quan

objExcel.Cells(i + PosInc, 4) = rst!spis_reason

i = i + 1

rst.MoveNext

Loop

End With

objExcel.Visible = True

Exit Sub

ErrProc:

objExcel.Quit

Set objExcel = Nothing

End Sub

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