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 = "