求指导一下吧。！删除行后不能再添加了。。
--------------------编程问答-------------------- 信息不全，无法看出问题...--------------------编程问答-------------------- 建议这样来操作数据库：
增加记录：
conn.execute "INSERT INTO 表名(字符型字段,数值型字段) VALUES('"& 字符型变量 &"',"& 数值型变量 &")"
修改记录：
conn.execute "UPDATE 表名 SET ... WHERE ..."
删除记录：
conn.execute "DELTE FROM 表名 WHERE ..."
--------------------编程问答--------------------
Private Sub Grid1_KeyUp(KeyCode As Integer, Shift As Integer)
Dim Idx&
Dim SpName As String
If Grid1.TextMatrix(Grid1.RowSel, 1) = "" Then Exit Sub
If KeyCode = vbKeyDelete Then
SpName = Grid1.TextMatrix(Grid1.RowSel, 2)
If MsgBox("确定不需要【" & SpName & "】吗？！", vbYesNo + vbQuestion, "删除提示") = vbYes Then
If Grid1.Rows > 2 Then
For i = 1 To IDlist.Count
If IDlist.Item(i) = Grid1.TextMatrix(Grid1.RowSel, Grid1.Cols - 1) Then
IDlist.Remove i
Exit For
End If
Next
Grid1.RemoveItem Grid1.RowSel: Grid1.Refresh
If Grid1.Rows = 2 Then Unload Me: Me.Show
HeJi
End If
End If
End If
End Sub
我自己来结贴吧，朋友帮忙处理好了 --------------------编程问答-------------------- 上面的代码我也没发对。被 bcrun 气的。我发全代码吧 那位朋友有用就复制下去用吧。
--------------------编程问答--------------------
Dim RsHy As ADODB.Recordset
Dim Pid As Long
Private Sub chkHyJs_Click()
If chkHyJs.Value = xtpChecked Then
If Val(lblHyPis.Caption) >= Val(txtPis.Text) Then
txtHyOut = Format(lblPis.Caption, "")
txtHyIn = Val(lblHyPis.Caption) - Val(lblPis.Caption)
txtPis = 0
Else
txtHyOut = lblHyPis.Caption
txtHyIn = 0
txtPis = Val(txtPis) - Val(lblHyPis.Caption)
End If
Else
txtPis = Format(lblPis.Caption, "")
txtHyOut = 0
txtHyIn = 0
End If
txtInPis_Change
End Sub
Private Sub cmd_Click(Index As Integer)
Select Case Index
Case 0
TxtTm_KeyPress 13
Case 1
Grid1_KeyUp vbKeyDelete, 0
End Select
End Sub
Private Sub Form_Load()
Dim RsBh As ADODB.Recordset, MsgText As String
sqlBh = "select * from Sell_Main order by id"
Set RsBh = ExecuteSQL(sqlBh, MsgText)
FormatGrid
Grid1.Rows = 2
If RsBh.RecordCount > 0 Then
RsBh.MoveLast
lblCode.Caption = "XS" & Format(Now, "yyyymmdd") & left(Mid(RsBh("billcode"), 11, 17), 7) + 1
Else
lblCode.Caption = "XS" & Format(Now, "yyyymmdd") & "1000001"
End If
RsBh.Close
Set RsBh = Nothing
Set IDlist = New Collection
Pic1.Visible = False
Grid.Visible = False
End Sub
Private Sub Grid1_AfterEdit(ByVal Row As Long, ByVal Col As Long)
With Grid1
c = .TextMatrix(Row, 5)
If c <> "" Then
For i = 1 To .Rows - 1
.TextMatrix(i, 6) = Val(.TextMatrix(i, 5)) * Val(.TextMatrix(i, 3))
.TextMatrix(i, 7) = Val(.TextMatrix(i, 6)) * Val(.TextMatrix(i, 8))
.TextMatrix(i, 10) = Val(.TextMatrix(i, 9)) * Val(.TextMatrix(i, 5))
.TextMatrix(i, 11) = Val(.TextMatrix(i, 5)) * Val(.TextMatrix(i, 4))
.TextMatrix(i, 12) = Val(.TextMatrix(i, 11)) * Val(.TextMatrix(i, 8))
Next
HeJi
End If
End With
End Sub
Private Sub Grid1_BeforeEdit(ByVal Row As Long, ByVal Col As Long, Cancel As Boolean)
'*******先将设editable=2
'限定不可编辑列,如有5列
If Col = 0 Then Cancel = True
If Col = 1 Then Cancel = True
If Col = 2 Then Cancel = True
If Col = 3 Then Cancel = True
If Col = 4 Then Cancel = True
If Col = 6 Then Cancel = True
If Col = 7 Then Cancel = True
End Sub
Private Sub Grid1_KeyPressEdit(ByVal Row As Long, ByVal Col As Long, KeyAscii As Integer)
Dim Numbers As String '允许输入的字符
If Grid1.Col = 5 Then '第5列
Numbers = "1234567890" + Chr(46) + Chr(8)
If InStr(Numbers, Chr(KeyAscii)) = 0 Then
KeyAscii = 0
End If
End If
End Sub
Private Sub Grid1_KeyUp(KeyCode As Integer, Shift As Integer)
Dim Idx&
Dim SpName As String
If Grid1.TextMatrix(Grid1.RowSel, 1) = "" Then Exit Sub
If KeyCode = vbKeyDelete Then
SpName = Grid1.TextMatrix(Grid1.RowSel, 2)
If MsgBox("确定不需要【" & SpName & "】吗？！", vbYesNo + vbQuestion, "删除提示") = vbYes Then
If Grid1.Rows > 2 Then
For i = 1 To IDlist.Count
If IDlist.Item(i) = Grid1.TextMatrix(Grid1.RowSel, Grid1.Cols - 1) Then
IDlist.Remove i
Exit For
End If
Next
Grid1.RemoveItem Grid1.RowSel: Grid1.Refresh
If Grid1.Rows = 2 Then Unload Me: Me.Show
HeJi
End If
End If
End If
End Sub
Private Sub txtHy_KeyPress(KeyAscii As Integer)
If Trim(txtHy.Text) = Empty Then Exit Sub
If KeyAscii <> 13 Then Exit Sub
Dim SQL2 As String
Dim MsgText As String
SQL2 = "select * from hy where card='" & Trim(txtHy.Text) & "'"
Set RsHy = ExecuteSQL(SQL2, MsgText)
If Not RsHy.EOF Then
If IsNull(RsHy("name")) = False And RsHy("name") <> Empty Then lblHyName.Caption = RsHy("name") Else lblHyName.Caption = ""
lblHyJf.Caption = RsHy("jf")
lblHyPis.Caption = RsHy("pis")
chkHyJs.Enabled = True
txtHyOut.Enabled = True
txtHyIn.Enabled = True
Else
chkHyJs.Enabled = False
lblHyJf.Caption = 0
lblHyPis.Caption = 0
lblHyName.Caption = "..."
End If
End Sub
Private Sub txtInPis_Change()
If txtInPis = "" Then
TxtOutPis = ""
Else
TxtOutPis.Text = Val(txtInPis.Text) - Val(txtPis.Text)
End If
End Sub
Private Sub txtJmPis_KeyPress(KeyAscii As Integer)
If Trim(txtJmPis.Text) = Empty Then Exit Sub
If KeyAscii <> 13 Then Exit Sub
txtPis.Text = Val(lblPis.Caption) - Val(txtJmPis.Text)
txtInPis_Change
End Sub
Private Sub TxtTm_KeyPress(KeyAscii As Integer)
If Trim(TxtTm.Text) = Empty Then Exit Sub
If KeyAscii <> 13 Then Exit Sub
Dim SQL1 As String
Dim MsgText As String
Dim RS1 As ADODB.Recordset
SQL1 = "select * from SP where TM='" & Trim(TxtTm.Text) & "'"
Set RS1 = ExecuteSQL(SQL1, MsgText)
If Not RS1.EOF Then
FormatGrid
With Grid1
.Editable = flexEDKbdMouse '不编辑
.SelectionMode = 1
For i = 1 To IDlist.Count '将ID数记录在 IDlist 这个集合里,防止有同名重复行出现!
If RS1.Fields(0).Value = IDlist(i) Then
For q = 1 To .Rows - 2 '这里用循环来判断(q,条码列号)=txttm" 列值数量+1
If .TextMatrix(q, 1) = TxtTm.Text Then
.TextMatrix(q, 5) = .TextMatrix(q, 5) + 1
.TextMatrix(q, 6) = .TextMatrix(q, 5) * .TextMatrix(q, 3)
If RS1("jf") = True Then
.TextMatrix(q, 7) = RS1("jfl") * .TextMatrix(q, 6)
.TextMatrix(q, 12) = RS1("jfl") * .TextMatrix(q, 4)
Else
.TextMatrix(q, 7) = 0: .TextMatrix(q, 12) = 0
End If
.TextMatrix(q, 10) = .TextMatrix(q, 9) * .TextMatrix(q, 5)
.TextMatrix(q, 11) = .TextMatrix(q, 4) * .TextMatrix(q, 5)
.Row = q '焦点移动到当前行
Exit For
End If
Next
GoTo HeJi1
End If
Next
NewAdd:
.Rows = .Rows + 1
.TextMatrix(.Rows - 2, 1) = RS1("tm") '条码
.TextMatrix(.Rows - 2, 2) = RS1("name") '名称
.TextMatrix(.Rows - 2, 3) = RS1("sellpis") '零售价
.TextMatrix(.Rows - 2, 4) = RS1("hypis") '会员价
.TextMatrix(.Rows - 2, 5) = 1 ' 数量
.TextMatrix(.Rows - 2, 6) = .TextMatrix(.Rows - 2, 3) * .TextMatrix(.Rows - 2, 5) '金额
If RS1("jf") = True Then
.TextMatrix(.Rows - 2, 7) = RS1("jfl") * .TextMatrix(.Rows - 2, 5) * .TextMatrix(.Rows - 2, 3) '积分
.TextMatrix(.Rows - 2, 8) = RS1("jfl") '积分率
Else: .TextMatrix(.Rows - 2, 7) = 0: .TextMatrix(.Rows - 2, 8) = 0: End If
.TextMatrix(.Rows - 2, 9) = RS1("inpis") '进价
.TextMatrix(.Rows - 2, 10) = .TextMatrix(.Rows - 2, 5) * .TextMatrix(.Rows - 2, 9) '成本
.TextMatrix(.Rows - 2, 11) = .TextMatrix(.Rows - 2, 5) * .TextMatrix(.Rows - 2, 4) '会员总价
.TextMatrix(.Rows - 2, 12) = .TextMatrix(.Rows - 2, 11) * .TextMatrix(.Rows - 2, 8) '会员积分
.Row = .Rows - 2
.TextMatrix(.Rows - 2, 13) = RS1.Fields(0).Value
IDlist.Add RS1.Fields(0).Value
End With
HeJi1: '合计
HeJi
End If
TxtTm.Text = ""
TxtTm.SetFocus
End Sub
Public Sub HeJi()
With Grid1
For i = 1 To .Rows - 1
SumNum = SumNum + Val(.TextMatrix(i, 5))
SumHJ = SumHJ + Val(.TextMatrix(i, 6))
SumJF = SumJF + Val(.TextMatrix(i, 7))
SumCB = SumCB + Val(.TextMatrix(i, 10))
SumHy = SumHy + Val(.TextMatrix(i, 11))
SumHyJf = SumHyJf + Val(.TextMatrix(i, 12))
.TextMatrix(.Rows - 2, 0) = i - 1
Next
lblSl.Caption = SumNum
lblPis.Caption = Format(SumHJ, "0.00")
txtPis = SumHJ
lblJf.Caption = SumJF
SumHyZ = SumHy
SumHyJfZ = SumHyJf
SumCBZ = SumCB
End With
End Sub
Public Sub FormatGrid()
With Grid1
.Cols = 14
.SelectionMode = 1
.FormatString = "^ 行号 |< 商品条码 |< 商品名称 |> 零售价 |> 会员价|> 数 量 |> 金 额 |> 积 分|> 积分率|> 进价|> 成本|> 折价|> 折分"
.ColWidth(0) = 500: .ColWidth(1) = 1000: .ColWidth(2) = 2000: .ColWidth(3) = 1000
.ColWidth(4) = 1000: .ColWidth(5) = 1000: .ColWidth(6) = 1200: .ColWidth(7) = 0: .ColWidth(8) = 0
.ColWidth(9) = 0: .ColWidth(10) = 0: .ColWidth(11) = 0: .ColWidth(12) = 20: .ColWidth(13) = 600
'6行后的宽度在调试期间为显示状态。正常运行时，宽度改为0
.RowHeight(-1) = 330
End With
End Sub
--------------------编程问答-------------------- 呜呜，易做图啊易做图。当初你在QQ群中问时，就已经和你说明了的啊，你看你现在的粘贴出来的代码中，那个Collection对象的增减元素使用的参数没配对啊：
Private Sub cmdJz_Click()
Dim Rsr As ADODB.Recordset
Dim RsMx As ADODB.Recordset
Dim RsSp As ADODB.Recordset
Dim Mid As Long
Dim MsgText As String
Dim TSQL As String
If lblSl.Caption = 0 Then MsgBox "无销售商品，不能结账! ", vbCritical: Exit Sub
'主帐目表操作
TSQL = "select * from Sell_main"
Set Rsr = ExecuteSQL(TSQL, MsgText)
If Rsr.BOF Or Rsr.EOF Then
Pid = 1
Else
Rsr.MoveLast
Pid = Rsr("pid") + 1
End If
MidPrn = Pid
Rsr.AddNew
If lblHyName.Caption <> "..." Then
Rsr("hycode") = txtHy.Text
Rsr("HyJf") = lblJf.Caption 'SumHyJfZ
If chkHyJs.Value = xtpChecked Then
Rsr("HyPis") = txtHyIn.Text
Else
Rsr("HyPis") = 0
End If
ElseIf hyId <> "" Then
Rsr("hycode") = 0
Rsr("HyJf") = 0
Rsr("HyPis") = 0
End If
Rsr("Pid") = Pid
Rsr("Billtype") = "销售"
Rsr("Billcode") = lblCode.Caption
Rsr("Billdate") = Now
Rsr("Num") = lblSl.Caption
Rsr("FullPis") = lblPis.Caption
Rsr("SfPis") = txtPis.Text
Rsr("lirong") = Val(txtPis.Text) - SumCBZ
Rsr("chenben") = SumCBZ
Rsr("JieMian") = txtJmPis
Rsr("InPis") = txtInPis
Rsr("OutPis") = TxtOutPis
'Rsr("") = txt
Rsr("czy") = Czy
Rsr.Update
Rsr.Close
'会员表操作
If lblHyName.Caption <> "..." Then
RsHy("jf") = RsHy("jf") + Val(lblJf.Caption)
RsHy("jfpis") = RsHy("jfpis") + Val(txtPis.Text)
RsHy("jfnum") = RsHy("jfnum") + 1
RsHy("lastpis") = txtPis.Text
RsHy("lastdate") = Now
If chkHyJs.Value = xtpChecked Then
RsHy("Pis") = 0
End If
RsHy.Update
RsHy.Close
Set RsHy = Nothing
End If
'加入明细表
TSQL = "select * from Sell_mx"
Set RsMx = ExecuteSQL(TSQL, MsgText)
With Grid1
For i = 1 To .Rows - 2
RsMx.AddNew
RsMx("PID") = Pid
RsMx("billcode") = lblCode.Caption
RsMx("billtype") = "销售"
RsMx("billdate") = Now
RsMx("lid") = .TextMatrix(i, 0)
RsMx("tm") = .TextMatrix(i, 1)
RsMx("name") = .TextMatrix(i, 2)
RsMx("pis") = .TextMatrix(i, 3)
RsMx("num") = .TextMatrix(i, 5)
RsMx("sumpis") = .TextMatrix(i, 6)
RsMx.Update
TxtSQL = "select * from sp where tm='" & Grid1.TextMatrix(i, 1) & "'"
Set RsSp = ExecuteSQL(TxtSQL, MsgText)
RsSp("num") = RsSp("num") - .TextMatrix(i, 5)
RsSp.Update
Next
End With
RsMx.Close
Set RsMx = Nothing
RsSp.Close
Set RsSp = Nothing
PrintOut
MsgBox "销售成功！继续下一单", vbInformation, "提示"
Unload Me
Me.Show
End Sub
Public Sub PrintOut()
'On Error GoTo ErrorPrint
Dim UserNAME As String, Tel As String, Address As String, UserINFO As String
Dim RS As ADODB.Recordset, MsgText As String, Sql As String
Sql = "select * from UserInfo"
Set RS = ExecuteSQL(Sql, MsgText)
' If Trim(RS("userName")) <> "" Or IsNull(RS("userName")) = False Then UserNAME = RS("userName")
' If Trim(RS("TEL")) <> "" Or IsNull(RS("TEL")) = False Then Tel = RS("TEL")
' If Trim(RS("广告词")) <> "" Or IsNull(RS("广告词")) = False Then UserINFO = RS("广告词")
' If Trim(RS("address")) <> "" Or IsNull(RS("address")) = False Then Address = RS("address")
RS.Close
Set RS = Nothing
Sql = "select name as 商品名称,pis as 单价,num as 数量,sumpis as 金额 from sell_mx where pid=" & Pid & " order by lid"
Set RS = ExecuteSQL(Sql, MsgText)
Set Grid.DataSource = RS
Printer.FontSize = 11
Printer.FontBold = True
Printer.Print " " & UserNAME & "结帐单"
Printer.FontBold = False
Printer.FontSize = 9
Printer.Print " "
Printer.Print "流水单号:" & lblCode.Caption
Dim i
For i = 1 To Grid.Rows
Printer.FontSize = 9
Printer.Font.Name = "宋体"
Printer.CurrentX = L1(i - 1).left
Printer.CurrentY = L1(i - 1).top
Printer.Print Grid.TextMatrix(i - 1, 1)
Printer.CurrentX = L2(i - 1).left
Printer.CurrentY = L2(i - 1).top
Printer.Print Grid.TextMatrix(i - 1, 2)
Printer.CurrentX = L3(i - 1).left
Printer.CurrentY = L3(i - 1).top
Printer.Print Grid.TextMatrix(i - 1, 3)
Printer.CurrentX = L4(i - 1).left
Printer.CurrentY = L4(i - 1).top
Printer.Print Grid.TextMatrix(i - 1, 4)
Load L1(i): Load L2(i): Load L3(i): Load L4(i)
L1(i).Move L1(i - 1).left, L1(i - 1).top + L1(i - 1).Height + 70
L2(i).Move L2(i - 1).left, L2(i - 1).top + L2(i - 1).Height + 70
L3(i).Move L3(i - 1).left, L3(i - 1).top + L3(i - 1).Height + 70
L4(i).Move L4(i - 1).left, L4(i - 1).top + L4(i - 1).Height + 70
Next
Pic1.AutoRedraw = True
Pic1.AutoSize = True
Printer.Print " "
Printer.Print "打印时间:" & Now()
Printer.EndDoc
Exit Sub
'ErrorPrint:
'MsgBox Err.Description
End Sub
你Add时没把第2个参数"键字符串"写进去，Remove时又怎么可能匹配到呢？
经常有些初学者遇到这方面理解困惑时，希望有人能帮他们把代码改好，并最好尽量以他们能理解的语言解释清楚，但我前段时间忙一个苦闷任务郁闷得很，实在是没时间和心情仔细推敲和修改代码及说明什么的啊
BTW:搞开发经常会焦头烂额的，不要遇到不顺心的就退群啊
IDlist.Add RS1.Fields(0).Value
IDlist.Remove Idx
2013-1-12 16:52:13查看前后消息
前天不是已经告诉你了吗。你说你VB6最基础的Collection的Add,Remove不会用，我说msdn lib里有啊
2013-1-12 16:56:02查看前后消息
你打开msdn lib啊，在“Collection 对象”这个索引条目下，有：
Collection 对象关键字总结
作用关键字建立一个Collection对象。Collection添加对象到集合对象中。Add从集合对象中删除对象。Remove引用集合对象中的项。Item
那你还是先在msdn中查collection的帮助打下基础吧，别急着写程序
16:56:36
你要写的至少几千行超市系统，如果你这基础知识都静不下心来看，那么…………
17:23:06
Add 方法的语法具有下列对象限定符和命名参数：
部分 描述
object 必需的。对象表达式，其值为“应用于”列表中的对象。
item 必需的。任意类型的表达式，指定要添加到集合中的成员。
key 可选的。唯一字符串表达式，指定可以使用的键字符串，代替位置索引来访问集合中的成员。
补充：VB , 基础类
