VB仓库管理系统源代码

1、1.请购作业程序Private Sub ComCX_Click()查询'在"编号"文本框中输入编号，连接数据库，查询编号，并将"编号","品名","规格","单位","单价"的数据分别导入到相应文本框。Set CN = New ADODB.ConnectionSet Rs = New ADODB.RecordsetCN.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & "

2、F:VB设计专用仓库数据资料仓库数据资料.mdb;Persist Security Info=False"'打开数据库Rs.CursorType = adOpenStatic '制定一个静态游标Rs.LockType = adLockOptimistic '设置锁定模式为开放式 Rs.Open "select * from JLBH where FtextBHSJ Like'" & "%" & Trim(textBHSJ.Text) & "%" & "

3、'", CN DoEvents Do Until Rs.EOF = True If Rs.EOF = False Then listBHSJ1.AddItem (Rs.Fields(0) listPMSJ1.AddItem (Rs.Fields(1) listGGSJ1.AddItem (Rs.Fields(2) listDWSJ1.AddItem (Rs.Fields(3) listDJSJ1.AddItem (Rs.Fields(4) Rs.MoveNext End If LoopEnd SubPrivate Sub comFHZY_Click()返回上页frmQGZY.

4、HidefrmCKGLXT.ShowEnd SubPrivate Sub comQD_Click()录入数据If textBHSJ.Text = "" Or textPMSJ.Text = "" Or textGGSJ.Text = "" Or textDWSJ.Text = "" Or textDJSJ.Text = "" Or textQGSLSJ.Text = "" Then MsgBox "请将数据补充完整!" textBHSJ.Text = &q

5、uot;" textPMSJ.Text = "" textGGSJ.Text = "" textDWSJ.Text = "" textDJSJ.Text = "" textQGSLSJ.Text = ""Else Dim cnn As New Connection, rst As New Recordset, fid As Field Dim strSql As String, strconn As String strSql = "Select textBHSJ From

6、qgzy where textBHSJ= '" & Trim(textBHSJ.Text) & "'" strconn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" strconn = strconn & "F:VB设计专用仓库数据资料仓库数据资料.mdb'" cnn.ConnectionString = strconn cnn.Open Set rst = cnn.Execute(strSql) str1 = &

7、quot;Insert Into qgzy (textBHSJ,textPMSJ,textGGSJ,textDWSJ,textDJSJ,textQGSJ)" str1 = str1 + "Values('" & Trim(textBHSJ.Text) & "','" & Trim(textPMSJ.Text) & "','" & Trim(textGGSJ.Text) & "','" & Tri

8、m(textDWSJ.Text) & "','" & Trim(textDJSJ.Text) & "','" & Trim(textQGSLSJ.Text) & "')" cnn.Execute str1 listBHSJ1.AddItem (Trim(textBHSJ.Text) listPMSJ1.AddItem (Trim(textPMSJ.Text) listGGSJ1.AddItem (Trim(textGGSJ.Text) listDWSJ1.

9、AddItem (Trim(textDWSJ.Text) listDJSJ1.AddItem (Trim(textDJSJ.Text) listQGSLSJ1.AddItem (Trim(textQGSLSJ.Text) MsgBox "数据输入成功!" rst.Close cnn.Close Set Rs = Nothing Set CN = Nothing textBHSJ.Text = "" textPMSJ.Text = "" textGGSJ.Text = "" textDWSJ.Text = "

10、;" textDJSJ.Text = "" textQGSLSJ.Text = ""End IfEnd SubPrivate Sub comsc_Click()删除If listBHSJ1.SelCount > 0 Then For i = listBHSJ1.ListCount - 1 To 0 Step -1 If listBHSJ1.Selected(i) Then textBHSJ.Text = listBHSJ1.List(i) textPMSJ.Text = listPMSJ1.List(i) textGGSJ.Text =

11、listGGSJ1.List(i) textDWSJ.Text = listDWSJ1.List(i) textDJSJ.Text = listDJSJ1.List(i) textQGSLSJ.Text = listQGSLSJ1.List(i) End If NextEnd IfDim cnn As New Connection, rst As New Recordset, fid As FieldDim strSql As String, strconn As String strSql = "Select FtextBHSJ From jlbh where FtextBHSJ=

12、'" & Trim(textBHSJ.Text) & "'" strconn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" strconn = strconn & "F:VB设计专用仓库数据资料仓库数据资料.mdb'" cnn.ConnectionString = strconn cnn.Open Set rst = cnn.Execute(strSql) If rst.EOF = False Then str1

13、= "Delete from qgzy where FtextBHSJ='" & Trim(textBHSJ.Text) & "'" cnn.Execute str1 textBHSJ.Text = "" textPMSJ.Text = "" textGGSJ.Text = "" textDWSJ.Text = "" textDJSJ.Text = "" textQGSLSJ.Text = "" If l

14、istBHSJ1.SelCount > 0 Then For i = listBHSJ1.ListCount - 1 To 0 Step -1 If listBHSJ1.Selected(i) Then listBHSJ1.RemoveItem (i) listPMSJ1.RemoveItem (i) listGGSJ1.RemoveItem (i) listDWSJ1.RemoveItem (i) listDJSJ1.RemoveItem (i) listQGSLSJ1.RemoveItem (i) End If Next End If MsgBox "数据已删除！"

15、; Else MsgBox "无此数据！" textBHSJ.Text = "" textPMSJ.Text = "" textGGSJ.Text = "" textDWSJ.Text = "" textDJSJ.Text = "" textQGSLSJ.Text = "" End Ifrst.Closecnn.CloseSet Rs = NothingSet CN = NothingEnd Sub以下是listbox串连显示Private Sub lis

16、tBHSJ1_Click() If listBHSJ1.SelCount > 0 Then For i = listBHSJ1.ListCount - 1 To 0 Step -1 If listBHSJ1.Selected(i) Then listPMSJ1.Selected(i) = True End If Next End IfEnd SubPrivate Sub listDJSJ1_Click() If listDJSJ1.SelCount > 0 Then For i = listDJSJ1.ListCount - 1 To 0 Step -1 If listDJSJ1.

17、Selected(i) Then listQGSLSJ1.Selected(i) = True End If Next End IfEnd SubPrivate Sub listDWSJ1_Click() If listDWSJ1.SelCount > 0 Then For i = listDWSJ1.ListCount - 1 To 0 Step -1 If listDWSJ1.Selected(i) Then listDJSJ1.Selected(i) = True End If Next End IfEnd SubPrivate Sub listGGSJ1_Click() If l

18、istGGSJ1.SelCount > 0 Then For i = listGGSJ1.ListCount - 1 To 0 Step -1 If listGGSJ1.Selected(i) Then listDWSJ1.Selected(i) = True End If Next End IfEnd SubPrivate Sub listPMSJ1_Click() If listPMSJ1.SelCount > 0 Then For i = listPMSJ1.ListCount - 1 To 0 Step -1 If listPMSJ1.Selected(i) Then li

19、stGGSJ1.Selected(i) = True End If Next End IfEnd SubPrivate Sub listQGSLSJ1_Click() If listQGSLSJ1.SelCount > 0 Then For i = listQGSLSJ1.ListCount - 1 To 0 Step -1 If listQGSLSJ1.Selected(i) Then listBHSJ1.Selected(i) = True End If Next End IfEnd Sub2.增加料号程序Private Sub comFHZY_Click()返回上页 frmJLBH

20、.Hide frmCKGLXT.ShowEnd SubPrivate Sub comSCBH_Click()删除If listBHSJ1.SelCount > 0 Then For i = listBHSJ1.ListCount - 1 To 0 Step -1 If listBHSJ1.Selected(i) Then textBHSJ.Text = listBHSJ1.List(i) textPMSJ.Text = listPMSJ1.List(i) textGGSJ.Text = listGGSJ1.List(i) textDWSJ.Text = listDWSJ1.List(i)

21、 textDJSJ.Text = listDJSJ1.List(i) End If NextEnd IfDim cnn As New Connection, rst As New Recordset, fid As FieldDim strSql As String, strconn As String strSql = "Select FtextBHSJ From jlbh where FtextBHSJ='" & Trim(textBHSJ.Text) & "'" strconn = "Provider=Mi

22、crosoft.Jet.OLEDB.4.0;Data Source='" strconn = strconn & "F:VB设计专用仓库数据资料仓库数据资料.mdb'" cnn.ConnectionString = strconn cnn.Open Set rst = cnn.Execute(strSql) If rst.EOF = False Then str1 = "Delete * from jlbh where FtextBHSJ='" & Trim(textBHSJ.Text) & &q

23、uot;'" cnn.Execute str1 textBHSJ.Text = "" textPMSJ.Text = "" textGGSJ.Text = "" textDWSJ.Text = "" textDJSJ.Text = "" If listBHSJ1.SelCount > 0 Then For i = listBHSJ1.ListCount - 1 To 0 Step -1 If listBHSJ1.Selected(i) Then listBHSJ1.Rem

24、oveItem (i) listPMSJ1.RemoveItem (i) listGGSJ1.RemoveItem (i) listDWSJ1.RemoveItem (i) listDJSJ1.RemoveItem (i) End If Next End If MsgBox "编号已删除！" Else MsgBox "无此编号！请确认后重新输入" textBHSJ.Text = "" textPMSJ.Text = "" textGGSJ.Text = "" textDWSJ.Text = &q

25、uot;" textDJSJ.Text = "" End Ifrst.Closecnn.CloseSet Rs = NothingSet CN = NothingEnd SubPrivate Sub comZJBH_Click()新增料号If textBHSJ.Text = "" Or textPMSJ.Text = "" Or textGGSJ.Text = "" Or textDWSJ.Text = "" Or textDJSJ.Text = "" Then M

26、sgBox "请将数据补充完整!" textBHSJ.Text = "" textPMSJ.Text = "" textGGSJ.Text = "" textDWSJ.Text = "" textDJSJ.Text = ""Else Dim cnn As New Connection, rst As New Recordset, fid As Field Dim strSql As String, strconn As String strSql = "Select

27、 FtextBHSJ From jlbh where FtextBHSJ= '" & Trim(textBHSJ.Text) & "'" strconn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" strconn = strconn & "F:VB设计专用仓库数据资料仓库数据资料.mdb'" cnn.ConnectionString = strconn cnn.Open Set rst = cnn.Execute

28、(strSql) If rst.EOF = False Then MsgBox "该编号已存在，不能追加！" Else str1 = "Insert Into jlbh (FtextBHSJ,FtextPMSJ,FtextGGSJ,FtextDWSJ,FtextDJSJ)" str1 = str1 + "Values('" & Trim(textBHSJ.Text) & "','" & Trim(textPMSJ.Text) & "',

29、9;" & Trim(textGGSJ.Text) & "','" & Trim(textDWSJ.Text) & "','" & Trim(textDJSJ.Text) & "')" cnn.Execute str1 listBHSJ1.AddItem (Trim(textBHSJ.Text) listPMSJ1.AddItem (Trim(textPMSJ.Text) listGGSJ1.AddItem (Trim(textGGSJ.

30、Text) listDWSJ1.AddItem (Trim(textDWSJ.Text) listDJSJ1.AddItem (Trim(textDJSJ.Text) MsgBox "恭喜您，添加成功!"End If rst.Close cnn.Close Set Rs = Nothing Set CN = Nothing textBHSJ.Text = "" textPMSJ.Text = "" textGGSJ.Text = "" textDWSJ.Text = "" textDJSJ.Text = "