'定义数据集对象
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 作者:
jiayu 时间: 2007-12-26 13:41
