发新话题
打印

我现在用VB和SQL做课程设计,有点小问题,麻烦帮看看

我现在用VB和SQL做课程设计,有点小问题,麻烦帮看看

'定义数据集对象
Dim rs1 As New ADODB.Recordset
Dim rs2 As New ADODB.Recordset
Dim rs3 As New ADODB.Recordset
Dim rs4 As New ADODB.Recordset
Dim rs5 As New ADODB.Recordset
Dim rs6 As New ADODB.Recordset
Dim s, Y, i, j     '定义变量
Public khbh As String
Private Sub DataCombo1_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyReturn Then
     MS1.Row = 1: MS1.Col = 1
     Text1.Visible = True     'text1输入框可见
     Text1.SetFocus     'text1获得焦点
  End If
End Sub
Private Sub DataGrid1_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyReturn Then
     With Adodc1.Recordset
          '赋值给MS1表格
          If .Fields("客户全称") <> "" Then kh.Text = .Fields("客户全称")
          If .Fields("客户编号") <> "" Then khbh = .Fields("客户编号")
     End With
     kh.SetFocus
     DataGrid1.Visible = False
     
  End If
  If KeyCode = vbKeyEscape Then     '按ESC键dataGrid1不可见
     DataGrid1.Visible = False
     kh.SetFocus     'kh获得焦点
  End If
End Sub
Private Sub Form_Load()
  rq.Text = Date
  Combo1.AddItem ("现金")
  Combo1.AddItem ("支票")
  Combo1.AddItem ("计账")
  Combo1.ListIndex = 0
  MS1.Rows = 102: MS1.Cols = 9     '定义MS1表的总行数、总列数
  '定义MS1表格的列宽及表头
  s = Array("300", "2100", "1200", "1800", "1500", "765", "1200", "1200", "1200")
  Y = Array("xh", "商品名称", "商品编号", "规格", "产地", "单位", "单价", "数量", "金额")
  For i = 0 To 8
   MS1.ColWidth(i) = s(i): MS1.TextMatrix(0, i) = Y(i)
  Next i
  '定义MS1表的列序号
  For i = 1 To 101
      MS1.TextMatrix(i, 0) = i
  Next i
  rq.Text = Date     '设置销售日期
End Sub
Private Sub Form_Unload(Cancel As Integer)
frm_main.Enabled = True
End Sub
Private Sub kh_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyReturn Then
     Adodc1.RecordSource = "select * from 客户信息表 where 简称 like '" + Trim(kh.Text) + "'+ '%'"
     Adodc1.Refresh
     If Adodc1.Recordset.RecordCount > 0 Then
        DataGrid1.Visible = True
        DataGrid1.SetFocus
     Else
        DataGrid1.Visible = False
        DataCombo1.SetFocus
     End If
  End If
End Sub
Private Sub grid1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
  With Adodc2.Recordset
  If .RecordCount > 0 Then    '判断是否有记录
   If .Fields("商品名称") <> "" Then
      '赋值给MS1表格
      If .Fields("商品名称") <> "" Then MS1.TextMatrix(MS1.Row, 1) = Trim(.Fields("商品名称"))
      If .Fields("商品编号") <> "" Then MS1.TextMatrix(MS1.Row, 2) = Trim(.Fields("商品编号"))
      If .Fields("规格") <> "" Then MS1.TextMatrix(MS1.Row, 3) = Trim(.Fields("规格"))
      If .Fields("产地") <> "" Then MS1.TextMatrix(MS1.Row, 4) = Trim(.Fields("产地"))
      If .Fields("单位") <> "" Then MS1.TextMatrix(MS1.Row, 5) = Trim(.Fields("单位"))
      If .Fields("单价") <> "" Then MS1.TextMatrix(MS1.Row, 6) = .Fields("单价")
      Text1.Text = MS1.Text     '赋值给text1
      Text1.SetFocus     'text1获得焦点
      MS1.Col = 6
      grid1.Visible = False     'grid1不可见
     Else
      MsgBox ("无数据选择!!!")
      grid1.Visible = False
      Text1.SetFocus
   End If
  End If
  End With
  Text1.SetFocus
End If
If KeyCode = vbKeyEscape Then     '按ESC键grid1不可见
    grid1.Visible = False
    Text1.SetFocus     'text1获得焦点
End If
End Sub
'Private Sub DataList1_KeyDown(KeyCode As Integer, Shift As Integer)
  'If KeyCode = vbKeyReturn Then
    ' kh.Text = Trim(DataList1.BoundText)     '赋值给kh.text
  '   DataList1.Visible = False
' End If
'End Sub
Private Sub MS1_Click()     '单击MS1表格
  If MS1.Row >= 1 And MS1.TextMatrix(MS1.Row - 1, 7) <> "" Then
     Text1.Visible = True
     Text1.SetFocus
  End If
End Sub
Private Sub MS1_entercell()     '确定text1在MS1表中的位置
  Dim X As String, Y As String, p As String     '显示声明一个单精度浮点型变量
  If MS1.CellWidth <= 0 Or MS1.CellHeight <= 0 Then Exit Sub
  X = MS1.TextMatrix(MS1.FixedRows, MS1.Col)     '给变量赋初值
  Y = MS1.TextMatrix(MS1.Row, 0)     '给变量赋初值
  If Y <> "" Then
     If MS1.Col - MS1.LeftCol <= 3 Then
        MS1.LeftCol = MS1.LeftCol + 1
     End If
     If MS1.CellWidth > 0 And MS1.CellHeight > 0 Then
      Text1.Width = MS1.CellWidth: Text1.Height = MS1.CellHeight
      Text1.Left = MS1.CellLeft + MS1.Left: Text1.Top = MS1.CellTop + MS1.Top
     End If
     X = MS1.TextMatrix(MS1.FixedRows, MS1.Col): Y = MS1.TextMatrix(MS1.Row, 0)
     p = MS1.TextMatrix(MS1.Row, MS1.Col)
     Text1.Text = MS1.Text
     Text1.SelStart = 0: Text1.SelLength = Len(Text1.Text)
  End If
End Sub
Private Sub MS1_RowColChange()     '格式化MS1表格中的第6列、第8列
  For i = 1 To 101
   If MS1.TextMatrix(i, 1) <> "" Then
    MS1.TextMatrix(MS1.Row, 6) = Format(MS1.TextMatrix(MS1.Row, 6), "#0.00")
    MS1.TextMatrix(MS1.Row, 8) = Val(MS1.TextMatrix(MS1.Row, 7)) * Val(MS1.TextMatrix(MS1.Row, 6))                         '计算金额
    MS1.TextMatrix(MS1.Row, 8) = Format(MS1.TextMatrix(MS1.Row, 8), "#0.00")
   End If
  Next i
End Sub
Private Sub sf_Change()      '求未付金额
  wf.Text = Format((Val(yfje.Text) - Val(sf.Text)), "0.00")
End Sub
Private Sub sf_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyReturn Then Combc.SetFocus
End Sub
Private Sub sl_Change()      '求应付金额
yfje.Text = Format((Val(hjje.Text) * (Val(zk.Text) / 10)) + (Val(yfje.Text) * (Val(sl.Text) / 100)), "0.00")
End Sub
Private Sub sl_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then Combo1.SetFocus
End Sub
Private Sub zk_Change()     '求应付金额
sl_Change
End Sub
Private Sub hjje_Change()     '求应付金额
sl_Change
wf.Text = Format((Val(yfje.Text) - Val(sf.Text)), "0.00")
End Sub
Private Sub zk_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyReturn Then sl.SetFocus                   '按回车键sl获得焦点
End Sub
Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyReturn Then sf.SetFocus                   '按回车键sf获得焦点
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
  grid1.Visible = False
  If MS1.Col = 1 Then
   With Adodc2.Recordset
   If Adodc2.Recordset.RecordCount > 0 Then
     '赋值给MS1表格
      If .Fields("商品名称") <> "" Then MS1.TextMatrix(MS1.Row, 1) = Trim(.Fields("商品名称"))
      If .Fields("商品编号") <> "" Then MS1.TextMatrix(MS1.Row, 2) = Trim(.Fields("商品编号"))
      If .Fields("规格") <> "" Then MS1.TextMatrix(MS1.Row, 3) = Trim(.Fields("规格"))
      If .Fields("产地") <> "" Then MS1.TextMatrix(MS1.Row, 4) = Trim(.Fields("产地"))
      If .Fields("单位") <> "" Then MS1.TextMatrix(MS1.Row, 5) = Trim(.Fields("单位"))
      If .Fields("单价") <> "" Then MS1.TextMatrix(MS1.Row, 6) = .Fields("单价")
      Text1.SetFocus     '按回车键text1获得焦点
      Text1.Text = MS1.Text     '赋值给text1
      grid1.Visible = False     'grid1不可见
      MS1.Col = 5     '将文本放置在第5列
   End If
   End With
  End If
  If MS1.Col = 8 Then
      MS1.Row = MS1.Row + 1
      MS1.Col = 1
    Else
      If MS1.Col + 1 <= MS1.Cols - 1 Then
         MS1.Col = MS1.Col + 1
       Else
         If MS1.Row + 1 <= MS1.Rows - 1 Then
            MS1.Row = MS1.Row + 1
            MS1.Col = 1
         End If
      End If
   End If
End If
If KeyCode = vbKeyUp Then
    If MS1.Row > 1 Then MS1.Row = MS1.Row - 1
End If
If KeyCode = vbKeyDown Then
    If MS1.Row < 99 Then MS1.Row = MS1.Row + 1
End If
If KeyCode = vbKeyLeft Then
    If Text1.Text <> "" Then
       Text1.SelStart = 0
       Text1.SelLength = Len(Text1.Text)
    End If
    If MS1.Col - 8 <= MS1.Cols + 1 Then
       MS1.Col = MS1.Col - 1
       If MS1.Col = 0 Then MS1.Col = 1
      Else
       If MS1.Row + 1 <= MS1.Row - 1 Then
          MS1.Row = MS1.Row + 1
          MS1.Col = 1
       End If
    End If
End If
If KeyCode = vbKeyRight Then
    If Text1.Text <> "" Then
       Text1.SelStart = 0
       Text1.SelLength = Len(Text1.Text)
    End If
    If MS1.Col + 1 <= MS1.Cols - 1 Then
       MS1.Col = MS1.Col + 1
      Else
       If MS1.Row + 1 <= MS1.Rows - 1 Then
          MS1.Row = MS1.Row + 1
          MS1.Col = 1
       End If
    End If
End If
If KeyCode = vbKeyPageDown And MS1.Col = 1 Then
   '查询商品信息
    Adodc2.RecordSource = "select * from 商品信息表 "
    Adodc2.Refresh
    grid1.Visible = True     'grid1可见
    grid1.SetFocus     'grid1获得焦点
End If
End Sub
Private Sub Text1_Change()
MS1.Text = Text1.Text     '赋值给MS1
If MS1.Col = 1 Then
  If Text1.Text = "" Then
     grid1.Visible = False
   Else
     '按商品名称或商品简称查询商品信息
     Adodc2.RecordSource = "select * from 商品信息表 where (商品名称 like '" + Text1.Text + "'+ '%')or(商品简称 like '" + Text1.Text + "'+'%')"
     Adodc2.Refresh
     If Adodc2.Recordset.RecordCount > 0 Then     '当记录大于零时
        grid1.Visible = True     'grid1可见
        Text1.SetFocus     'text1获得焦点
     End If
  End If
End If
If MS1.Col = 3 Then     '当到达第3列时
    If MS1.TextMatrix(MS1.Row, 1) = "" Then
       MsgBox ("无商品名称,请重新输入!!!")     '提示信息
       MS1.Col = 1
    End If
End If
If MS1.Col = 6 Then MS1.TextMatrix(MS1.Row, 8) = Val(MS1.TextMatrix(MS1.Row, 7)) * Val(MS1.TextMatrix(MS1.Row, 6))
If MS1.Col = 7 Then MS1.TextMatrix(MS1.Row, 8) = Val(MS1.TextMatrix(MS1.Row, 7)) * Val(MS1.TextMatrix(MS1.Row, 6))
Dim a, B As Single     '声明单精度浮点型变量
For i = 1 To 101
  If MS1.TextMatrix(i, 1) <> "" And MS1.TextMatrix(i, 7) <> "" Then
     pz.Text = i     '品种数
     a = Val(MS1.TextMatrix(i, 8)) + a     '求合计金额
     B = Val(MS1.TextMatrix(i, 7)) + B     '求合计数量
  End If
Next i
hjsl.Text = B: hjje.Text = Format(a, "0.00")    '格式化合计金额
End Sub
Private Sub Comdj_Click()     '登记
'确定文本框在MS1表格中的大小和位置
Text1.Width = MS1.CellWidth: Text1.Height = MS1.CellHeight
Text1.Left = MS1.CellLeft + MS1.Left: Text1.Top = MS1.CellTop + MS1.Top
MS1.Enabled = True
Dim lsph As Integer     '声明一个整型变量
'创建销售票号
rs2.Open "select * from 销售信息表 order by 票号", Cnn, adOpenKeyset, adLockOptimistic
If rs2.RecordCount > 0 Then
   If Not rs2.EOF Then rs2.MoveLast
   If rs2.Fields("票号") <> "" Then
      lsph = Val(Right(Trim(rs2.Fields("票号")), 4)) + 1
      ph.Text = Date & "xs" & Format(lsph, "0000")
   End If
  Else
   ph.Text = Date & "xs" & "0001"
End If
rs2.Close
'设置控件有效或无效
kh.Enabled = True: sf.Enabled = True: Combc.Enabled = True
Comqx.Enabled = True: Comdj.Enabled = False
Text1.Enabled = True: sf.Enabled = True
'清空数据
For i = 1 To 100
For j = 1 To 8
     MS1.TextMatrix(i, j) = ""
Next j
Next i
kh.Text = "": pz.Text = "0": hjsl.Text = "0"
hjje.Text = "0": sf.Text = "0": wf.Text = "0"
kh.SetFocus     'kh获得焦点
End Sub
Private Sub Combc_Click()     '保存
rs3.Open "select * from 销售信息表", Cnn, adOpenKeyset, adLockOptimistic     '打开数据库
If MS1.TextMatrix(1, 1) <> "" And MS1.TextMatrix(1, 7) <> "" Then
  For i = 1 To 100
   If MS1.TextMatrix(i, 1) <> "" And MS1.TextMatrix(i, 7) <> "" Then
    '添加新记录到"销售信息表"表中
     rs3.AddNew
     If MS1.TextMatrix(i, 1) <> "" Then rs3.Fields("商品名称") = Trim(MS1.TextMatrix(i, 1))
     If MS1.TextMatrix(i, 2) <> "" Then rs3.Fields("商品编号") = Trim(MS1.TextMatrix(i, 2))
     If MS1.TextMatrix(i, 3) <> "" Then rs3.Fields("规格") = Trim(MS1.TextMatrix(i, 3))
     If MS1.TextMatrix(i, 4) <> "" Then rs3.Fields("产地") = Trim(MS1.TextMatrix(i, 4))
     If MS1.TextMatrix(i, 5) <> "" Then rs3.Fields("单位") = Trim(MS1.TextMatrix(i, 5))
     If MS1.TextMatrix(i, 6) <> "" Then rs3.Fields("单价") = Val(MS1.TextMatrix(i, 6))
     If MS1.TextMatrix(i, 7) <> "" Then rs3.Fields("数量") = Val(MS1.TextMatrix(i, 7))
     If MS1.TextMatrix(i, 8) <> "" Then rs3.Fields("金额") = Val(MS1.TextMatrix(i, 8))
     If kh.Text <> "" Then rs3.Fields("客户全称") = Trim(kh.Text)
     rs3.Fields("操作员") = czy
     If rq.Text <> "" Then rs3.Fields("日期") = Trim(rq.Text)
     If ph.Text <> "" Then rs3.Fields("票号") = Trim(ph.Text)
     If DataCombo1.BoundText <> "" Then rs3.Fields("销售员") = Trim(DataCombo1.BoundText)
     rs3.Update
     '筛选符合商品编号的记录
     rs5.Open "select * from 商品信息表 where 商品编号='" & Trim(MS1.TextMatrix(i, 2)) & "'", Cnn, adOpenKeyset, adLockOptimistic
     If rs5.RecordCount > 0 Then     '当记录大于零时
        If rs5.Fields("商品名称") <> "" Then
         rs5.Fields("库存数量") = rs5.Fields("库存数量") - Val(MS1.TextMatrix(i, 7))
         rs5.Update
        End If
      Else
        MsgBox ("库存无此商品!")
     End If
     rs5.Close
     '添加记录到客户账款信息表表中
     rs6.Open "select * from 客户账款信息表", Cnn, adOpenKeyset, adLockOptimistic
     If rs6.EOF = False Then rs6.MoveLast
     rs6.AddNew
     If rq.Text <> "" Then rs6.Fields("日期") = rq.Text
     rs6.Fields("时间") = Time
     If ph.Text <> "" Then rs6.Fields("票号") = ph.Text
     If MS1.TextMatrix(i, 7) <> "" Then rs6.Fields("数量") = MS1.TextMatrix(i, 7)
     If MS1.TextMatrix(i, 8) <> "" Then rs6.Fields("金额小计") = MS1.TextMatrix(i, 8)
     If MS1.TextMatrix(i, 6) <> "" Then rs6.Fields("单价") = MS1.TextMatrix(i, 6)
     If MS1.TextMatrix(i, 5) <> "" Then rs6.Fields("单位") = MS1.TextMatrix(i, 5)
     If kh.Text <> "" Then rs6.Fields("客户全称") = kh.Text
     rs6.Fields("客户编号") = khbh
     If kh.Text <> "" Then rs6.Fields("摘要") = "销售:【" & kh.Text & "】的" & "【" & MS1.TextMatrix(i, 1) & "," & MS1.TextMatrix(i, 3) & "】"
     rs6.Update     '更新数据库
     rs6.Close
   End If
  Next i
  '添加新记录到"销售单据信息表"表中
  rs4.Open "select * from 销售单据信息表", Cnn, adOpenKeyset, adLockOptimistic
  rs4.AddNew
  If ph.Text <> "" Then rs4.Fields("销售票号") = Trim(ph.Text)
  rs4.Fields("品种数") = pz.Text
  rs4.Fields("数量") = hjsl.Text
  rs4.Fields("金额") = hjje.Text
  rs4.Fields("折扣") = zk.Text
  rs4.Fields("税率") = Val(sl.Text) / 100
  rs4.Fields("应付") = Val(yfje.Text)
  rs4.Fields("实付") = Val(sf.Text)
  rs4.Fields("未付") = Val(wf.Text)
  rs4.Fields("客户全称") = Trim(kh.Text)
  rs4.Fields("日期") = Trim(rq.Text)
  rs4.Fields("收款方式") = Combo1.Text
  If Val(wf.Text) <= 0 Then rs4.Fields("是否结清") = 1 Else rs4.Fields("是否结清") = 0
  rs4.Update     '更新数据库
  rs4.Close
  Adodc3.RecordSource = "select * from 客户账款信息表  where (客户编号 like '" + khbh + "'and 累计余额>0) "
  Adodc3.Refresh
  If Adodc3.Recordset.EOF = False Then Adodc3.Recordset.MoveLast
  If Adodc3.Recordset.RecordCount > 0 Then
  If Adodc3.Recordset.Fields("累计余额") <> "" Then khye.Text = Adodc3.Recordset.Fields("累计余额")
  End If
  Adodc3.RecordSource = "select * from 客户账款信息表  where (客户编号 like '" + khbh + "')"
  Adodc3.Refresh
  If Adodc3.Recordset.RecordCount > 0 Then
     If Adodc3.Recordset.EOF = False Then Adodc3.Recordset.MoveLast
     Adodc3.Recordset.Fields("欠款记帐") = Val(wf.Text)
     Adodc3.Recordset.Fields("累计余额") = Val(khye.Text) + Val(wf.Text)
     Adodc3.Recordset.Update
  End If
'设置控件有效或无效
  Combc.Enabled = False: Comdj.Enabled = True
  Comqx.Enabled = False: MS1.Enabled = False
  Text1.Visible = False: grid1.Visible = False: DataGrid1.Visible = False
Else
  MsgBox ("填写数据不完整,请核对,再保存!")
  MS1.Col = 1: MS1.Row = 1     '到第1行、到第1列
  grid1.Visible = False
End If
rs3.Close
End Sub
Private Sub Comqx_Click()                    '取消操作
For i = 1 To 101
     For j = 1 To 8
         MS1.TextMatrix(i, j) = ""
     Next j
Next i
MS1.Enabled = False: Comdj.Enabled = True: sf.Enabled = False
Text1.Visible = False
pz.Text = "0": hjje.Text = "0": hjsl.Text = "0"
sf.Text = "0": wf.Text = "0": kh.Text = ""
Comdj.SetFocus
End Sub
Private Sub Comend_Click()
  Call CmdEnd(Me)
End Sub

TOP

主要是保存那部分有错,帅哥美女们帮忙看看,就要交了。救救急

TOP

看哪一行报错,可能是数据类型不匹配的问题。

一般报错会报出错误在哪里,错误的提示对调试错误很有帮助。
换个头像,看见广告就眼红,直接封ID。

TOP

运行时就If DataCombo1.BoundText <> "" Then rs3.Fields("销售员") = Trim(DataCombo1.BoundText)后面部分出错,不知道该怎么该

TOP

发新话题