类型不匹配

jiadedifang 2010-10-14 11:25:37

Option Explicit
Dim bChange As Boolean '记录是否修改过数据
Public iMode As Integer '设置模式，1为添加模式，2为修改模式
Dim rs As ADODB.Recordset
Public strSQL As String '外部传入的SQL语句

Private Sub cmdExit_Click() '“退出”按钮
If bChange And cmdSave.Enabled Then '若数据被修改
If MsgBox("保存当前记录的变化吗？", vbQuestion + vbYesNo, _
"保存") = vbYes Then
Call cmdSave_Click '调用“保存”按钮事件代码
End If
End If
Unload Me '卸载窗体
End Sub

Private Sub cmdSave_Click() '“保存”按钮
Dim i As Integer
Dim str1 As String, strSQL1 As String
Dim sMeg As String
For i = 1 To 7 '判断第2~8个文本框中是否为空
If Trim(txtItem(i) & " ") = "" Then
Select Case i
Case 1
sMeg = "销售订单号"
Case 2
sMeg = "客户代码"
Case 3
sMeg = "药品代码"
Case 4
sMeg = "数量"
Case 5
sMeg = "订货单价"
Case 6
sMeg = "折扣比例"
Case 7
sMeg = "总金额"
End Select
str1 = "【" & str1 & "】不能为空！"
MsgBox str1, vbInformation + vbOKOnly, "提示"
txtItem(i).SetFocus '设置输入焦点
Exit Sub '退出过程
End If
Next i

If Trim(txtItem(9)) = "" Then
MsgBox "请指定药品的有效期限！", vbInformation + vbOKOnly, "提示"
txtItem(9).SetFocus '设置输入焦点
Exit Sub '退出过程
End If

If Not IsDate(Format(Trim(txtItem(9)), "yyyy-mm-dd")) Then
MsgBox "药品的有效期限请输入日期！", vbInformation + vbOKOnly, "提示"
txtItem(9).SetFocus '设置输入焦点
Exit Sub '退出过程
End If

For i = 4 To 7
If Not IsNumeric(Trim(txtItem(i))) Then
MsgBox "请输入数字！", vbInformation + vbOKOnly, "提示"
txtItem(9).SetFocus '设置输入焦点
Exit Sub '退出过程
End If
Next i

'添加判断是否有相同的ID记录
If iMode = 1 Then
strSQL1 = "SELECT * FROM jxc_SalesOrders WHERE so_id='" & Trim(txtItem(1)) & "'"
Set rs = QueryExt(strSQL1)
If Not rs.EOF Then
MsgBox "已经存在此销售订单编号！", vbInformation + vbOKOnly, "提示"
txtItem(1).SetFocus '设置输入焦点
Exit Sub '退出过程
End If
rs.Close '关闭记录集
End If

strSQL = "DELETE FROM jxc_SalesOrders WHERE so_id='" & Trim(txtItem(1)) & "'" '先删除已有记录
SQLExt strSQL

strSQL1 = "INSERT INTO jxc_SalesOrders VALUES('" '再加入新记录
strSQL1 = strSQL1 & Trim(txtItem(0)) & "','" '日期
strSQL1 = strSQL1 & Trim(Combo1(0).ItemData(Combo1(0).ListIndex)) & "','" '业务员
For i = 1 To 3 '订单号、客户代码、药品代码
strSQL1 = strSQL1 & Trim(txtItem(i)) & "','"
Next i
strSQL1 = strSQL1 & Trim(txtItem(9)) & "','" '有效期限

For i = 4 To 7 '数量、单价、折扣、总金额
strSQL1 = strSQL1 & Trim(txtItem(i)) & "','"
Next i
strSQL1 = strSQL1 & Trim(txtItem(8)) & "')" '备注
SQLExt strSQL1

If iMode = 1 Then '增加模式
MsgBox "添加记录成功！", vbInformation + vbOKOnly, "添加记录"
For i = 0 To 9 '清空各列表框
txtItem(i) = ""
Next i
For i = 0 To 2 '选择各组合框中的第1项
Combo1(i).ListIndex = 0
Next i
txtItem(0) = Format(Now, "yyyy-mm-dd") '设置日期格式
bChange = False '清除修改标志

ElseIf iMode = 2 Then
Unload Me '卸载当前窗体
End If
Unload frmOutOrders
frmOutOrders.strSQL = "SELECT so_id,so_date,so_saler,cus_id,cn_id," & _
" cn_enddate,so_amount,so_price,so_amount,so_total,so_memo " & _
"FROM jxc_SalesOrders" '设置窗体参数
frmOutOrders.Show
End Sub

Private Sub Combo1_Change(Index As Integer)
bChange = True '设置修改标志
End Sub

Private Sub Combo1_Click(Index As Integer)
Dim strSQL1 As String
If Index = 1 Then '客户名称组合框
txtItem(2) = Combo1(1).ItemData(Combo1(1).ListIndex)
strSQL1 = "SELECT cus_discount FROM jxc_cust WHERE cus_id='" & Trim(txtItem(2)) & "'"
Set rs = QueryExt(strSQL1) '查询对应客户的折扣比例
If Not rs.EOF Then
txtItem(6) = rs.Fields(0) '填写折扣比例
End If
rs.Close
ElseIf Index = 2 Then '药品名称组合框
strSQL1 = "SELECT cn_id,cn_outprice2 FROM jxc_CommName WHERE cn_name='" & Trim(Combo1(2).Text) & "'"
Set rs = QueryExt(strSQL1) '查询对应药品的零售价
If Not rs.EOF Then
txtItem(3) = rs.Fields(0) '药品编号
txtItem(5) = rs.Fields(1) '零售价格
End If
rs.Close
End If
End Sub

Private Sub Form_Load()
Dim i As Integer, strSQL1 As String
strSQL1 = "SELECT sl_id,sl_name FROM jxc_sales" '查询所有业务员
Set rs = QueryExt(strSQL1) '执行SQL语句

With Combo1(0) '添加业务员到组合框
.Clear
i = 0
Do While Not rs.EOF
.AddItem rs.Fields(1) '添加业务员名称
.ItemData(i) = rs.Fields(0) '保存业务员编号
i = i + 1
rs.MoveNext '处理下一记录
Loop
End With
rs.Close

strSQL1 = "SELECT cus_id,cus_name FROM jxc_cust" '获取所有客户
Set rs = QueryExt(strSQL1)
With Combo1(1)
.Clear
i = 0
Do While Not rs.EOF
.AddItem rs.Fields(1) '添加客户名称到组合框
.ItemData(i) = rs.Fields(0) '保存客户编号
i = i + 1
rs.MoveNext '处理下一记录
Loop
End With
rs.Close

strSQL1 = "SELECT cn_id,cn_name FROM jxc_CommName" '获取药品名称
Set rs = QueryExt(strSQL1) '执行SQL语句
With Combo1(2)
.Clear
i = 0
Do While Not rs.EOF
.AddItem rs.Fields(1) '添加药品名称
.ItemData(i) = rs.Fields(0) '保存药品编号
i = i + 1
rs.MoveNext '处理下一记录
Loop
End With
rs.Close

If iMode = 1 Then '添加模式
Me.Caption = "添加" & Me.Caption
For i = 0 To 8 '清空各文本框
txtItem(i).Text = ""
Next

For i = 0 To 2 '设置组合框中选中第1个选项
Combo1(i).ListIndex = 0
Next
ElseIf iMode = 2 Then '修改模式
Me.Caption = "修改" & Me.Caption
Set rs = QueryExt(strSQL) '从参数SQL语句生成记录集
If Not rs.EOF Then '若记录集不为空
With rs
txtItem(0) = .Fields(0) '订单日期
For i = 0 To Combo1(0).ListCount - 1 '查找业务员编号，显示业务员名称
If Combo1(0).ItemData(i) = Trim(.Fields(1)) Then
Combo1(0).ListIndex = i
Exit For
End If
Next

For i = 1 To 3 '订单号、客户代码、药品代码
txtItem(i) = .Fields(i + 1)
Next i
txtItem(9) = .Fields(5) '有效期限

For i = 0 To Combo1(1).ListCount - 1 '查找客户编号，显示客户名称
If Combo1(1).ItemData(i) = Trim(txtItem(2).Text) Then
Combo1(1).ListIndex = i
Exit For
End If
Next

For i = 0 To Combo1(2).ListCount - 1 '查找药品编号，显示药品名称
If Combo1(2).ItemData(i) = Trim(txtItem(3)) Then
Combo1(2).ListIndex = i
Exit For
End If
Next

For i = 4 To 8 '数量、单价、折扣、金额、备注
txtItem(i) = .Fields(i)
Next
End With
End If
End If
txtItem(0) = Format(Now, "yyyy-mm-dd") '设置日期格式
txtItem(0).Enabled = False '禁止修改“日期”
bChange = False '清除修改标志
End Sub

Private Sub Form_Unload(Cancel As Integer)
iMode = 0 '清空模式变量
End Sub
Private Sub txtItem_Change(Index As Integer)
Dim i As Integer, dTemp As Double
bChange = True '设置修改标志
If (Index >= 4 And Index <= 6) Then '为单价、数量、折扣文本框
dTemp = 0
If Trim(txtItem(4)) <> "" And Trim(txtItem(5)) <> "" _
And Trim(txtItem(6)) <> "" Then
dTemp = CDbl(txtItem(4)) * CDbl(txtItem(5)) * CDbl(txtItem(6)) / 100
End If
txtItem(7) = Format(dTemp, "#0.00") '总金额
End If
End Sub

Private Sub txtItem_GotFocus(Index As Integer)
txtItem(Index).SelStart = 0
txtItem(Index).SelLength = Len(txtItem(Index))
End Sub

dTemp = CDbl(txtItem(4)) * CDbl(txtItem(5)) * CDbl(txtItem(6)) / 100处显示类型不匹配数据库里面数据类型没有错误坐等答案

...全文