📄 frmchjinhuo.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomct2.ocx"
Begin VB.Form frmCHJinHuo
Caption = "进货修改"
ClientHeight = 6690
ClientLeft = 60
ClientTop = 345
ClientWidth = 9420
LinkTopic = "Form1"
ScaleHeight = 6690
ScaleWidth = 9420
StartUpPosition = 2 '屏幕中心
Begin VB.Frame Frame3
Caption = "操作选项"
Height = 1095
Left = 3720
TabIndex = 17
Top = 5400
Width = 5415
Begin VB.CommandButton cmdback
Caption = "返回"
Height = 495
Left = 3720
TabIndex = 22
Top = 360
Width = 1335
End
Begin VB.CommandButton cmddel
Caption = "删除"
Height = 495
Left = 2160
TabIndex = 21
Top = 360
Width = 1335
End
Begin VB.CommandButton cmdchange
Caption = "保存修改"
Height = 495
Left = 360
TabIndex = 20
Top = 360
Width = 1455
End
End
Begin VB.Frame Frame1
Caption = "输入进货编号"
Height = 1095
Left = 240
TabIndex = 16
Top = 5400
Width = 3135
Begin VB.CommandButton cmdinput
Caption = "信息定位"
Height = 495
Left = 1560
TabIndex = 19
Top = 360
Width = 1335
End
Begin VB.TextBox textinput
Height = 375
Left = 240
TabIndex = 18
Top = 360
Width = 975
End
End
Begin VB.Frame Frame2
Caption = "进货记录"
Height = 4455
Left = 240
TabIndex = 1
Top = 720
Width = 8895
Begin VB.TextBox Textjh
Enabled = 0 'False
Height = 270
Index = 0
Left = 1920
TabIndex = 8
Top = 720
Width = 2175
End
Begin VB.TextBox Textjh
Height = 270
Index = 1
Left = 1920
TabIndex = 7
Top = 1560
Width = 2175
End
Begin VB.TextBox Textjh
Height = 270
Index = 2
Left = 1920
TabIndex = 6
Top = 1920
Width = 2175
End
Begin VB.TextBox Textjh
Enabled = 0 'False
Height = 270
Index = 3
Left = 1920
TabIndex = 5
Top = 2280
Width = 2175
End
Begin VB.TextBox Textjh
Height = 1215
Index = 4
Left = 1920
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 4
Top = 3000
Width = 6375
End
Begin VB.ComboBox Combo2
Height = 300
Left = 1920
TabIndex = 2
Text = "Combo2"
Top = 1200
Width = 2175
End
Begin MSComCtl2.DTPicker DTPickerjh
Height = 255
Left = 1920
TabIndex = 3
Top = 2640
Width = 2175
_ExtentX = 3836
_ExtentY = 450
_Version = 393216
Format = 184614913
CurrentDate = 38517
End
Begin VB.Label Labjh
Caption = "进货编号："
Height = 255
Index = 0
Left = 600
TabIndex = 15
Top = 720
Width = 1095
End
Begin VB.Label Labjh
Caption = "商品名称："
Height = 255
Index = 2
Left = 600
TabIndex = 14
Top = 1200
Width = 1095
End
Begin VB.Label Labjh
Caption = "单价："
Height = 255
Index = 3
Left = 600
TabIndex = 13
Top = 1560
Width = 1095
End
Begin VB.Label Labjh
Caption = "数量："
Height = 255
Index = 4
Left = 600
TabIndex = 12
Top = 1920
Width = 1095
End
Begin VB.Label Labjh
Caption = "数额："
Height = 255
Index = 5
Left = 600
TabIndex = 11
Top = 2280
Width = 1095
End
Begin VB.Label Labjh
Caption = "日期："
Height = 255
Index = 6
Left = 600
TabIndex = 10
Top = 2640
Width = 1095
End
Begin VB.Label Labjh
Caption = "备注："
Height = 255
Index = 7
Left = 600
TabIndex = 9
Top = 3000
Width = 1095
End
End
Begin VB.Label Label1
Alignment = 2 'Center
Caption = "进货信息修改"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 255
Left = 3480
TabIndex = 0
Top = 240
Width = 2295
End
End
Attribute VB_Name = "frmCHJinHuo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim inputid As Integer
Dim spname As String
Dim spcount As Integer
Dim spNowName As String
Dim spNowCount As Integer
Private Sub CmdBack_Click()
Unload Me
End Sub
Private Sub cmdChange_Click()
Dim sql, sqljh As String
spNowName = Trim(Combo2.Text)
spNowCount = Val(Trim(Textjh(2).Text))
If spNowName = spname Then
sql = "delete from 进货表 where 进货编号='" & Trim(Textjh(0).Text) & "'"
ExeSQL (sql)
'******商品数量变化更新库存******
If spNowCount <> spcount Then
Call updatekc
End If
If Textjh(4).Text <> "" Then
sqljh = "insert into 进货表(ID,进货编号,商品编号,结账方式,单价,数量,总额,日期,备注) "
sqljh = sqljh & "values(" & inputid & ",'" & Trim(Textjh(0).Text) & "','" & spid(Combo2.Text) & "','现金'," & Val(Trim(Textjh(1).Text)) & "," & Val(Trim(Textjh(2).Text)) & "," & Val(Trim(Textjh(3).Text)) & ",'" & DTPickerjh.Value & "','" & Trim(Textjh(4).Text) & "')"
Else
sqljh = "insert into 进货表(ID,进货编号,商品编号,结账方式,单价,数量,总额,日期) "
sqljh = sqljh & "values(" & inputid & ",'" & Trim(Textjh(0).Text) & "','" & spid(Combo2.Text) & "','现金'," & Val(Trim(Textjh(1).Text)) & "," & Val(Trim(Textjh(2).Text)) & "," & Val(Trim(Textjh(3).Text)) & ",'" & DTPickerjh.Value & "')"
End If
ExeSQL (sqljh)
Else
sql = "delete from 进货表 where 进货编号='" & Trim(Textjh(0).Text) & "'"
ExeSQL (sql)
If Textjh(4).Text <> "" Then
sqljh = "insert into 进货表(ID,进货编号,商品编号,结账方式,单价,数量,总额,日期,备注) "
sqljh = sqljh & "values(" & inputid & ",'" & Trim(Textjh(0).Text) & "','" & spid(Combo2.Text) & "','现金'," & Val(Trim(Textjh(1).Text)) & "," & Val(Trim(Textjh(2).Text)) & "," & Val(Trim(Textjh(3).Text)) & ",'" & DTPickerjh.Value & "','" & Trim(Textjh(4).Text) & "')"
Else
sqljh = "insert into 进货表(ID,进货编号,商品编号,结账方式,单价,数量,总额,日期) "
sqljh = sqljh & "values(" & inputid & ",'" & Trim(Textjh(0).Text) & "','" & spid(Combo2.Text) & "','现金'," & Val(Trim(Textjh(1).Text)) & "," & Val(Trim(Textjh(2).Text)) & "," & Val(Trim(Textjh(3).Text)) & ",'" & DTPickerjh.Value & "')"
End If
ExeSQL (sqljh)
End If
MsgBox "进货记录修改成功", vbInformation + vbOKOnly, "系统提示"
cmdInput.Enabled = True
cmdChange.Enabled = False
cmddel.Enabled = False
End Sub
Public Sub updatekc() '更新进货信息到库存中
Dim rskc As ADODB.Recordset
Dim sqlkc As String
Dim sqlinkc As String
Dim spbianhao As String
spbianhao = spid(Trim(Combo2.Text))
sqlkc = "select * from 库存表 where 商品编号='" & spbianhao & "'"
Set rskc = ExeSQL(sqlkc)
If rskc.EOF Then
sqlinkc = "insert into 库存表(商品编号,商品名称,数量) values('" & spbianhao & "','" & Trim(Combo2.Text) & "'," & Val(Trim(Textjh(2).Text)) & ")"
ExeSQL (sqlinkc)
Else
rskc.Fields("数量") = Val(rskc.Fields("数量")) + (spNowCount - spcount)
rskc.Update
rskc.Close
Set rskc = Nothing
End If
End Sub
Private Sub cmddel_Click()
'*****修改库存****
Dim sqlkc As String
Dim rskc As ADODB.Recordset
sqlkc = "select * from 库存表 where 商品名称='" & spname & "'"
Set rskc = ExeSQL(sqlkc)
If rskc("数量") < spcount Then
rskc.Close
Set rskc = Nothing
MsgBox "库存不足，此进货记录不能删除", vbCritical + vbOKOnly, "系统提示"
Exit Sub
Else
rskc("数量") = rskc("数量") - spcount
rskc.Update
rskc.Close
Set rskc = Nothing
Dim sql As String
sql = "delete from 进货表 where 进货编号='" & Trim(Textjh(0).Text) & "'"
ExeSQL (sql)
MsgBox "记录删除成功"
End If
cmdInput.Enabled = True
cmdChange.Enabled = False
cmddel.Enabled = False
End Sub
Private Sub cmdInput_Click()
If textinput.Text = "" Then
MsgBox "请输入进货编号", vbExclamation + vbOKOnly, "系统提示"
Exit Sub
End If
Dim sql As String
Dim rs As ADODB.Recordset
sqlFindJH = "select 进货编号 from 进货表 where 进货编号='" & Trim(textinput.Text) & "'"
Set rs = ExeSQL(sqlFindJH)
If rs.EOF Then
MsgBox "该进货编号不存在,请重新输入", vbExclamation, "系统提示"
Exit Sub
rs.Close
Set rs = Nothing
End If
Dim rsjh As ADODB.Recordset
sqlFindJH = "select 进货表.ID as 进货ID,进货表.进货编号,商品表.商品名称,进货表.结账方式,"
sqlFindJH = sqlFindJH & "进货表.单价,进货表.数量,进货表.总额,进货表.日期,进货表.备注 "
sqlFindJH = sqlFindJH & "from 进货表,商品表 "
sqlFindJH = sqlFindJH & "where 进货表.商品编号=商品表.商品编号 and "
sqlFindJH = sqlFindJH & "进货表.进货编号='" & Trim(textinput.Text) & "'"
Set rsjh = ExeSQL(sqlFindJH)
inputid = rsjh("进货ID")
spname = rsjh("商品名称")
spcount = rsjh("数量")
Textjh(0).Text = rsjh("进货编号")
Combo2.Text = rsjh("商品名称")
Textjh(1).Text = rsjh("单价")
Textjh(2).Text = rsjh("数量")
Textjh(3).Text = rsjh("总额")
DTPickerjh = Format(rsjh("日期"), "yyyy-mm-dd hh:mm:ss")
Textjh(4).Text = rsjh("备注")
cmdInput.Enabled = False
cmdChange.Enabled = True
cmddel.Enabled = True
End Sub
Private Sub Form_Load()
Call loadSP(Combo2)
cmdInput.Enabled = True
cmdChange.Enabled = False
cmddel.Enabled = False
Me.DTPickerjh.Value = Now()
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set frmCHJinHuo = Nothing
End Sub
Private Sub loadSP(combo As ComboBox) '加载商品名称的过程
On Error GoTo errorhandle
Dim rssp As ADODB.Recordset
Dim sqlsp As String
sqlsp = "select 商品名称 from 商品表"
Set rssp = ExeSQL(sqlsp)
combo.Clear
Do While Not rssp.EOF
combo.AddItem (rssp.Fields(0))
rssp.MoveNext
Loop
combo.ListIndex = 0
rssp.Close
Set rssp = Nothing
Exit Sub
errorhandle:
If Err.Number = 380 Then
Resume Next
End If
End Sub
Private Sub Textjh_Change(Index As Integer)
If Index = 1 Or Index = 2 Then
Textjh(3).Text = Val(Textjh(1).Text) * Val(Textjh(2).Text)
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -