批量核销


Public Function MainFunction(ByVal sKey As String, oList As Object, ByRef bCancel As Boolean)

Dim frmX As New frmVerification

Dim vec As New KFO.Vector

Dim RsYear As ADODB.Recordset '当前年份

Dim RsPeriod As ADODB.Recordset '当前期间

Dim Rs As ADODB.Recordset

Dim strYear As String

Dim strPeriod As String

Dim strSQL As String

Dim strIDlist As String

Dim oBillData As Object '中间层组件

Dim I As Integer, J As Integer, K As Integer

On Error GoTo err_handle:

Set oBillData = CreateObject("BIllDataAccess.GetData")

strSQL = "SELECT FValue FROM t_systemprofile WHERE FCateGory='IC' AND FKEY='CurrentYear'"

Set RsYear = oBillData.ExecuteSQL(MMTS.PropsString, strSQL)

If RsYear.EOF Then

MsgBox "当前年份未获取到，无法核销", vbOKOnly, "xxxx"

Exit Function

Else

strYear = RsYear.Fields("FValue")

End If

strSQL = "SELECT FValue FROM t_systemprofile WHERE FCateGory='IC' AND FKEY='CurrentPeriod'"

Set RsPeriod = oBillData.ExecuteSQL(MMTS.PropsString, strSQL)

If RsPeriod.EOF Then

MsgBox "当前期间未获取到，无法核销", vbOKOnly, "xxxx"

Exit Function

Else

strPeriod = Right("00" & RsPeriod.Fields("FValue"), 2)

End If

oList.MultiSelect = 1

Set vec = oList.ListSelectBillInfo

If vec.Size = 0 Then

Exit Function

Else

If vec(1)("ftrantype") <> 5 Then

MsgBox "该功能只能在委外入库序时薄中使用", vbOKOnly, "xxxx"

Exit Function

End If

End If

For I = 1 To vec.Size

If strIDlist = "" Then

strIDlist = " (b.finterid=" & vec(I)("finterid") & " and b.fentryid=" & vec(I)("fentryid") & " )"

Else

strIDlist = strIDlist & " or (b.finterid=" & vec(I)("finterid") & " and b.fentryid=" & vec(I)("fentryid") & " )"

End If

Next I

If strIDlist = "" Then

MsgBox "未选中单据", vbOKOnly, "xxxx"

Exit Function

End If

strSQL = "select CONVERT(varchar(7),fdate,120) fyp, a.FDate,case a.FPurposeID when 14190 then '普通订单' when 14191 then '返修订单' end FPurposeID,isnull(a.FCheckerID,0) FCheckerID,isnull(c.FName,'') fsupplyname,a.FBillNo ,isnull(d.FName,'') fstockname " _

& " ,e.FNumber ,e.FName ,e.FModel ,f.FName funitname,FAuxQtyMust,Fauxqty,b.FOrderBillNo,b.FBatchNo ,b.FInterID ,b.FEntryID ,b.FCheckStatus ,b.FOrderInterID ,b.FOrderEntryID,isnull(b.FSecQty,0) FSecQty " _

& " from ICStockBill a inner join ICStockBillEntry b on a.FInterID =b.FInterID " _

& " left join t_Supplier c on a.FSupplyID =c.FItemID " _

& " left join t_Stock d on b.FDCStockID =d.FItemID " _

& " left join t_ICItem e on b.FItemID =e.FItemID " _

& " left join t_MeasureUnit f on b.FUnitID=f.FMeasureUnitID " _

& " Where a.FTranType = 5 And (" & strIDlist & ")"

Set Rs = oBillData.ExecuteSQL(MMTS.PropsString, strSQL)

'合法性检测

'1.是否存在未审核单据

Rs.Filter = " fcheckerid=0 "

If Not Rs.EOF Then

MsgBox "存在未审核单据，请检查(" & Rs.Fields("FBillNo") & ")", vbOKOnly, "xxxx"

Exit Function

End If

'2.是否存在已核销单据

Rs.Filter = " FCheckStatus<>0 "

If Not Rs.EOF Then

MsgBox "存在已核销单据，请检查(" & Rs.Fields("FBillNo") & ")", vbOKOnly, "xxxx"

Exit Function

End If

'3.是否存在不是当前期间的单据

Rs.Filter = " fyp <>'" & strYear & "-" & strPeriod & "'"

If Not Rs.EOF Then

MsgBox "存在非当前期间单据，请检查(" & Rs.Fields("FBillNo") & ")", vbOKOnly, "xxxx"

Exit Function

End If

Set Module1.tmpRs = Rs.Clone()

frmX.Show vbModal

Set frmX = Nothing

Set RsYear = Nothing

Set RsPeriod = Nothing

Set Rs = Nothing

Exit Function

err_handle:

MsgBox Err.Description & vbCrLf & "", vbOKOnly, "xxxx"

End Function

----

Dim blnBusy As Boolean

'qk 20160405

'委外入库表头初始化

Private Sub initInBill()

With sprInBill

.MaxRows = 1: .MaxCols = 19

.Row = SpreadHeader:

.Col = 1: .CellType = CellTypeEdit: .Text = "选择": .BackColor = &H8000000F: .ColWidth(1) = 0

.Col = 2: .CellType = CellTypeEdit: .Text = "日期": .BackColor = &H8000000F: .ColWidth(2) = 8

.Col = 3: .CellType = CellTypeEdit: .Text = "加工单位": .BackColor = &H8000000F: .ColWidth(3) = 15.125

.Col = 4: .CellType = CellTypeEdit: .Text = "单据编号": .BackColor = &H8000000F: .ColWidth(4) = 11.625

.Col = 5: .CellType = CellTypeEdit: .Text = "委外类型": .BackColor = &H8000000F: .ColWidth(5) = 8

.Col = 6: .CellType = CellTypeEdit: .Text = "收料仓库": .BackColor = &H8000000F: .ColWidth(6) = 8

.Col = 7: .CellType = CellTypeEdit: .Text = "材料代码": .BackColor = &H8000000F: .ColWidth(7) = 8

.Col = 8: .CellType = CellTypeEdit: .Text = "材料名称": .BackColor = &H8000000F: .ColWidth(8) = 16.875

.Col = 9: .CellType = CellTypeEdit: .Text = "规格型号": .BackColor = &H8000000F: .ColWidth(9) = 8

.Col = 10: .CellType = CellTypeEdit: .Text = "单位": .BackColor = &H8000000F: .ColWidth(10) = 4.125

.Col = 11: .CellType = CellTypeEdit: .Text = "应收数量": .BackColor = &HFFFF80: .ColWidth(11) = 10.5

.Col = 12: .CellType = CellTypeEdit: .Text = "实收数量": .BackColor = &HFFFF80: .ColWidth(12) = 10.5

.Col = 13: .CellType = CellTypeEdit: .Text = "辅助数量": .BackColor = &HFFFF80: .ColWidth(13) = 10.5

.Col = 14: .CellType = CellTypeEdit: .Text = "订单单号": .BackColor = &H8000000F: .ColWidth(14) = 19.375

.Col = 15: .CellType = CellTypeEdit: .Text = "批号": .BackColor = &H8000000F: .ColWidth(15) = 17

.Col = 16: .CellType = CellTypeEdit: .Text = "FInterid": .BackColor = &H8000000F: .ColWidth(16) = 8

.Col = 17: .CellType = CellTypeEdit: .Text = "FEntryid": .BackColor = &H8000000F: .ColWidth(17) = 8

.Col = 18: .CellType = CellTypeEdit: .Text = "FOrderInterID": .BackColor = &H8000000F: .ColWidth(18) = 8

.Col = 19: .CellType = CellTypeEdit: .Text = "FOrderEntryID": .BackColor = &H8000000F: .ColWidth(19) = 8

End With

End Sub

'qk 20160406

'委外出库表头初始化

Private Sub initOutBill()

With sprOutBill

.MaxRows = 0: .MaxCols = 25

.Row = SpreadHeader:

.Col = 1: .CellType = CellTypeEdit: .Text = "选择": .BackColor = &H8000000F: .ColWidth(1) = 0

.Col = 2: .CellType = CellTypeEdit: .Text = "日期": .BackColor = &H8000000F: .ColWidth(2) = 8

.Col = 3: .CellType = CellTypeEdit: .Text = "加工单位": .BackColor = &H8000000F: .ColWidth(3) = 13.5

.Col = 4: .CellType = CellTypeEdit: .Text = "单据编号": .BackColor = &H8000000F: .ColWidth(4) = 11.375

.Col = 5: .CellType = CellTypeEdit: .Text = "委外类型": .BackColor = &H8000000F: .ColWidth(5) = 7.25

.Col = 6: .CellType = CellTypeEdit: .Text = "材料代码": .BackColor = &H8000000F: .ColWidth(6) = 8

.Col = 7: .CellType = CellTypeEdit: .Text = "材料名称": .BackColor = &H8000000F: .ColWidth(7) = 10.875

.Col = 8: .CellType = CellTypeEdit: .Text = "规格型号": .BackColor = &H8000000F: .ColWidth(8) = 8

.Col = 9: .CellType = CellTypeEdit: .Text = "单位": .BackColor = &H8000000F: .ColWidth(9) = 4.5

.Col = 10: .CellType = CellTypeEdit: .Text = "批号": .BackColor = &H8000000F: .ColWidth(10) = 8

.Col = 11: .CellType = CellTypeEdit: .Text = "数量": .BackColor = &H8000000F: .ColWidth(11) = 7.5

.Col = 12: .CellType = CellTypeEdit: .Text = "未核销数量": .BackColor = &H8000000F: .ColWidth(12) = 8.875

.Col = 13: .CellType = CellTypeEdit: .Text = "本次核销数量": .BackColor = &HFFFF80: .ColWidth(13) = 9

.Col = 14: .CellType = CellTypeEdit: .Text = "未核销金额": .BackColor = &H8000000F: .ColWidth(14) = 8.875

.Col = 15: .CellType = CellTypeEdit: .Text = "本次核销金额": .BackColor = &H8000000F: .ColWidth(15) = 8

.Col = 16: .CellType = CellTypeEdit: .Text = "基本单位成本": .BackColor = &H8000000F: .ColWidth(16) = 8

.Col = 17: .CellType = CellTypeEdit: .Text = "单位成本": .BackColor = &H8000000F: .ColWidth(17) = 7.625

.Col = 18: .CellType = CellTypeEdit: .Text = "订单单号": .BackColor = &H8000000F: .ColWidth(18) = 15.125

.Col = 19: .CellType = CellTypeEdit: .Text = "核销标志": .BackColor = &H8000000F: .ColWidth(19) = 8

.Col = 20: .CellType = CellTypeEdit: .Text = "FInterid": .BackColor = &H8000000F: .ColWidth(20) = 8

.Col = 21: .CellType = CellTypeEdit: .Text = "FEntryid": .BackColor = &H8000000F: .ColWidth(21) = 8

.Col = 22: .CellType = CellTypeEdit: .Text = "FOrderInterID": .BackColor = &H8000000F: .ColWidth(22) = 8

.Col = 23: .CellType = CellTypeEdit: .Text = "FOrderEntryID": .BackColor = &H8000000F: .ColWidth(23) = 8

.Col = 24: .CellType = CellTypeEdit: .Text = "fleftqty": .BackColor = &H8000000F: .ColWidth(23) = 8 '保留未核销数量，便于计算

.Col = 25: .CellType = CellTypeEdit: .Text = "fleftamount": .BackColor = &H8000000F: .ColWidth(23) = 8 '保留未核销金额，便于计算

End With

End Sub

Private Sub Command1_Click()

If Not blnBusy Then

Verification

Else

MsgBox "核销进行中,请稍等...", vbOKOnly, "xxxx"

End If

End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)

If KeyAscii = 32 Then '空格核销

If Not blnBusy Then

Verification

Else

MsgBox "核销进行中,请稍等...", vbOKOnly, "xxxx"

End If

End If

End Sub

'qk 20160407 核销

Private Sub Verification()

Dim dblFDInterID As Double

Dim dblFDEntryID As Double

Dim dblFSInterID As Double

Dim dblFSEntryID As Double

Dim dblFQty As Double

Dim dblFAmount As Double

Dim dblFLeftQty As Double

Dim strUserName As String

Dim lngFUserID As Long

Dim strDate As String

Dim strSQL As String

Dim Rs As ADODB.Recordset

Dim oBillData As Object '中间层组件

Dim I As Integer, J As Integer, K As Integer

On Error GoTo err_handle:

If sprInBill.MaxRows <= 0 Then Exit Sub

If sprOutBill.MaxRows <= 0 Then Exit Sub

blnBusy = True

Set oBillData = CreateObject("BIllDataAccess.GetData")

'取用户ID

strUserName = MMTS.UserName()

strSQL = " select fuserid from t_User where fname='" & strUserName & "'"

Set Rs = oBillData.ExecuteSQL(MMTS.PropsString, strSQL)

lngFUserID = Rs.Fields("fuserid")

'取入库信息

sprInBill.Col = 2: strDate = Format(sprInBill.Text, "yyyy-mm-dd")

sprInBill.Col = 16: dblFDInterID = sprInBill.Text

sprInBill.Col = 17: dblFDEntryID = sprInBill.Text

'取出库信息

strSQL = ""

For I = 1 To sprOutBill.MaxRows

sprOutBill.Row = I

sprOutBill.Col = 12: dblFLeftQty = sprOutBill.Text

sprOutBill.Col = 13: dblFQty = sprOutBill.Text

sprOutBill.Col = 15: dblFAmount = sprOutBill.Text

sprOutBill.Col = 20: dblFSInterID = sprOutBill.Text

sprOutBill.Col = 21: dblFSEntryID = sprOutBill.Text

If dblFLeftQty < 0 Then

MsgBox "未核销数量为负,请检查", vbOKOnly, "xxxx"

blnBusy = False

Exit Sub

End If

If dblFQty > 0 Then

If strSQL = "" Then

strSQL = dblFDInterID & "," & dblFDEntryID & "," & dblFSInterID & "," & dblFSEntryID & "," & dblFQty & "," & dblFAmount & ",''" & strDate & "''," & lngFUserID

Else

strSQL = strSQL & "|" & dblFDInterID & "," & dblFDEntryID & "," & dblFSInterID & "," & dblFSEntryID & "," & dblFQty & "," & dblFAmount & ",''" & strDate & "''," & lngFUserID

End If

End If

Next I

strSQL = "exec qk_Verification '" & strSQL & "'"

Set Rs = oBillData.ExecuteSQL(MMTS.PropsString, strSQL)

If Not Rs.EOF Then

If Rs.Fields("fflag") = -1 Then

MsgBox "核销出现异常:" & Rs.Fields("fmsg"), vbOKOnly, "xxxx"

Exit Sub

End If

Else

MsgBox "核销出现异常,未返回查询数据", vbOKOnly, "xxxx"

Exit Sub

End If

'核销完后，删除当前行,并删除出库单

If sprInBill.MaxRows > 0 Then

sprInBill.DeleteRows sprInBill.Row, 1

sprInBill.MaxRows = sprInBill.MaxRows - 1

sprInBill.Refresh

sprOutBill.MaxRows = 0

If sprInBill.MaxRows > 0 Then

sprOutBill.SetFocus

sprInBill_Click 1, 1

sprOutBill.SetActiveCell 1, 13

End If

End If

blnBusy = False

Exit Sub

err_handle:

blnBusy = False

MsgBox Err.Description & vbCrLf & "", vbOKOnly, "xxxx"

End Sub

Private Sub Form_Load()

Screen.MousePointer = 1

initInBill

initOutBill

LoadInBill

sprInBill_Click 1, 1 '加载完入库信息后,默认选中第一行

blnBusy = False

End Sub

'qk 20160406 显示入库单信息

Private Sub LoadInBill()

Dim I As Integer

On Error GoTo err_handle:

I = 1

Do While Not Module1.tmpRs.EOF

With sprInBill

.MaxRows = I: .Row = I

.Col = 2: .Text = Format(Module1.tmpRs.Fields("FDate"), "yyyy-mm-dd"): .Lock = True

.Col = 3: .Text = Module1.tmpRs.Fields("fsupplyname"): .Lock = True

.Col = 4: .Text = Module1.tmpRs.Fields("FBillNo"): .Lock = True

.Col = 5: .Text = Module1.tmpRs.Fields("FPurposeID"): .Lock = True

.Col = 6: .Text = Module1.tmpRs.Fields("fstockname"): .Lock = True

.Col = 7: .Text = Module1.tmpRs.Fields("FNumber"): .Lock = True

.Col = 8: .Text = Module1.tmpRs.Fields("FName"): .Lock = True

.Col = 9: .Text = Module1.tmpRs.Fields("FModel"): .Lock = True

.Col = 10: .Text = Module1.tmpRs.Fields("funitname"): .Lock = True

.Col = 11: .Text = Module1.tmpRs.Fields("FAuxQtyMust"): .Lock = True: .TypeHAlign = TypeHAlignRight:

.Col = 12: .Text = Module1.tmpRs.Fields("Fauxqty"): .Lock = True: .TypeHAlign = TypeHAlignRight:

.Col = 13: .Text = Module1.tmpRs.Fields("FSecQty"): .Lock = True: .TypeHAlign = TypeHAlignRight:

.Col = 14: .Text = Module1.tmpRs.Fields("FOrderBillNo"): .Lock = True:

.Col = 15: .Text = Module1.tmpRs.Fields("FBatchNo"): .Lock = True:

.Col = 16: .Text = Module1.tmpRs.Fields("FInterID"): .Lock = True:

.Col = 17: .Text = Module1.tmpRs.Fields("FEntryID"): .Lock = True:

.Col = 18: .Text = Module1.tmpRs.Fields("FOrderInterID"): .Lock = True:

.Col = 19: .Text = Module1.tmpRs.Fields("FOrderEntryID"): .Lock = True:

End With

I = I + 1

Module1.tmpRs.MoveNext

Loop

Exit Sub

err_handle:

MsgBox Err.Description & vbCrLf & "LoadInBill", vbOKOnly, "xxxx"

End Sub

Private Sub Option1_Click() '按应收

Dim introw As Integer

Dim intcol As Integer

If sprInBill.MaxRows <= 0 Then Exit Sub

introw = sprInBill.Row

intcol = sprInBill.Col

sprInBill_Click intcol, introw

End Sub

Private Sub Option2_Click()

Dim introw As Integer

Dim intcol As Integer

If sprInBill.MaxRows <= 0 Then Exit Sub

introw = sprInBill.Row

intcol = sprInBill.Col

sprInBill_Click intcol, introw

End Sub

Private Sub Option3_Click()

Dim introw As Integer

Dim intcol As Integer

If sprInBill.MaxRows <= 0 Then Exit Sub

introw = sprInBill.Row

intcol = sprInBill.Col

sprInBill_Click intcol, introw

End Sub

Private Sub sprInBill_Click(ByVal Col As Long, ByVal Row As Long)

Dim lngFOrderInterID As Long

Dim lngFOrderEntryID As Long

Dim dblQty As Double '应收

Dim dblRealQty As Double '实收

If Row < 1 Then

Exit Sub

End If

sprInBill.SetSelection 1, Row, 18, Row

sprInBill.Row = Row:

sprInBill.Col = 18

lngFOrderInterID = sprInBill.Text

sprInBill.Col = 19

lngFOrderEntryID = sprInBill.Text

sprInBill.Col = 11

dblQty = sprInBill.Text

sprInBill.Col = 12

dblRealQty = sprInBill.Text

Screen.MousePointer = 11

LoadOutBill lngFOrderInterID, lngFOrderEntryID, dblQty, dblRealQty

Screen.MousePointer = 1

End Sub

Private Sub LoadOutBill(lngFOrderInterID As Long, lngFOrderEntryID As Long, dblQty As Double, dblRealQty As Double)

Dim Rs As ADODB.Recordset

Dim strSQL As String

Dim oBillData As Object '中间层组件

Dim intType As Integer '数量自动填充类型

Dim I As Integer

On Error GoTo err_handle:

sprOutBill.MaxRows = 0

If Option1.Value Then intType = 1 '按应收

If Option2.Value Then intType = 2 '按实收

If Option3.Value Then intType = 3 '按未核销

Set oBillData = CreateObject("BIllDataAccess.GetData")

strSQL = "exec qk_getVerOutBill " & lngFOrderInterID & "," & lngFOrderEntryID

Set Rs = oBillData.ExecuteSQL(MMTS.PropsString, strSQL)

If Rs.EOF Then

MsgBox "未查到对应的委外出库单,可能的原因有:1已被其他入库单核销 ;2未审核;3未发料。请检查", vbOKOnly, "xxxx"

sprInBill.DeleteRows sprInBill.Row, 1 '删除这一行

sprInBill.MaxRows = sprInBill.MaxRows - 1

Exit Sub

End If

I = 1

Do While Not Rs.EOF

With sprOutBill

.MaxRows = I: .Row = I

.Col = 2: .Text = Format(Rs.Fields("fdate"), "yyyy-mm-dd"): .Lock = True

.Col = 3: .Text = Rs.Fields("FSupplyIDName"): .Lock = True

.Col = 4: .Text = Rs.Fields("FBillNo"): .Lock = True

.Col = 5: .Text = Rs.Fields("FPurposeID"): .Lock = True

.Col = 6: .Text = Rs.Fields("ffullnumber"): .Lock = True

.Col = 7: .Text = Rs.Fields("fitemname"): .Lock = True

.Col = 8: .Text = Rs.Fields("fitemmodel"): .Lock = True

.Col = 9: .Text = Rs.Fields("funitidname"): .Lock = True

.Col = 10: .Text = Rs.Fields("fbatchno"): .Lock = True

.Col = 11: .Text = Rs.Fields("Fauxqty"): .Lock = True: .TypeHAlign = TypeHAlignRight

.Col = 12: .Lock = True: .TypeHAlign = TypeHAlignRight '未核销数量

If intType = 1 Then '应收

.Text = Rs.Fields("FPreQty") - dblQty:

ElseIf intType = 2 Then '实收

.Text = Rs.Fields("FPreQty") - dblRealQty:

ElseIf intType = 3 Then '未核销

.Text = 0:

End If

If CDbl(.Text) < 0 Then

MsgBox "未核销数量不正常，请注意手工调整", vbOKOnly, "xxxx"

End If

.Col = 13: .TypeHAlign = TypeHAlignRight '本次核销数量

If intType = 1 Then '应收

.Text = dblQty::: '本次核销数量

ElseIf intType = 2 Then '实收

.Text = dblRealQty

ElseIf intType = 3 Then '未核销

.Text = Rs.Fields("FPreQty")

End If

.Col = 14:: .Lock = True: .TypeHAlign = TypeHAlignRight '未核销金额'用减法，跟系统保持一致

If intType = 1 Then '应收

.Text = Format(Rs.Fields("fpreamount") - Format(dblQty * Rs.Fields("FPrice"), "0.00"), "0.00") ' (Rs.Fields("FPreQty") - dblQty) * Rs.Fields("FPrice")

ElseIf intType = 2 Then '实收

.Text = Format(Rs.Fields("fpreamount") - Format(dblRealQty * Rs.Fields("FPrice"), "0.00"), "0.00")

ElseIf intType = 3 Then '未核销

.Text = 0 ' Rs.Fields("FPreAmount")

End If

.Col = 15: .Lock = True: .TypeHAlign = TypeHAlignRight '本次核销金额,2位小数，四舍五入

If intType = 1 Then '应收

.Text = Format(dblQty * Rs.Fields("FPrice"), "0.00")

ElseIf intType = 2 Then '实收

.Text = Format(dblRealQty * Rs.Fields("FPrice"), "0.00")

ElseIf intType = 3 Then '未核销

.Text = Rs.Fields("FPreAmount"):

End If

.Col = 16: .Text = Rs.Fields("FPrice"): .Lock = True: .TypeHAlign = TypeHAlignRight

.Col = 17: .Text = Rs.Fields("Fauxprice"): .Lock = True: .TypeHAlign = TypeHAlignRight

.Col = 18: .Text = Rs.Fields("forderbillno"): .Lock = True

.Col = 19: .Text = Rs.Fields("FArapStatus"): .Lock = True

.Col = 20: .Text = Rs.Fields("FInterid"): .Lock = True

.Col = 21: .Text = Rs.Fields("FEntryid"): .Lock = True

.Col = 22: .Text = Rs.Fields("FOrderInterID"): .Lock = True

.Col = 23: .Text = Rs.Fields("FOrderEntryID"): .Lock = True

.Col = 24: .Text = Rs.Fields("FPreQty"): .Lock = True '

.Col = 25: .Text = Rs.Fields("FPreAmount"): .Lock = True

End With

Rs.MoveNext: I = I + 1

Loop

Exit Sub

err_handle:

MsgBox Err.Description & vbCrLf & "", vbOKOnly, "xxxx"

End Sub

Private Sub sprOutBill_EditChange(ByVal Col As Long, ByVal Row As Long)

Dim dbleditqty As Double '修改后的本次核销数量

Dim dbloldpreqty As Double '初始未核销数量

Dim dblprice As Double '基本单位单价

Dim dblAmount As Double '本次核销金额

Dim dblFPreAmount As Double '未核销金额

On Error GoTo err_handle:

With sprOutBill

.Row = Row

.Col = Col

If Trim(.Text) = "" Then

dbleditqty = 0

Else

dbleditqty = CDbl(.Text)

End If

.Col = 25:

dblFPreAmount = Format(.Text, "0.00")

'修改未核销数量

.Col = 24

dbloldpreqty = CDbl(.Text)

.Col = 12

.Text = dbloldpreqty - dbleditqty

'修改未核销金额

.Col = 16

dblprice = CDbl(.Text)

dblAmount = Format(dblprice * dbleditqty, "0.00")

.Col = 14

If dbloldpreqty <> dbleditqty Then

.Text = Format(dblFPreAmount - dblAmount, "0.00") '用减法，经过对比，系统就是用的减法，而不是未核销数量*单价 double在做浮点运算有误差

Else

.Text = 0

End If

'修改本次核销金额

.Col = 15

If dbloldpreqty <> dbleditqty Then

.Text = dblAmount

ElseIf dbloldpreqty = dbleditqty Then

.Text = dblFPreAmount

End If

If dbloldpreqty < dbleditqty Then

MsgBox "本次核销数量已经大于未核销数量，请检查", vbOKOnly, "xxxx"

End If

End With

Exit Sub

err_handle:

MsgBox Err.Description & vbCrLf & "sprOutBill_EditChange", vbOKOnly, "xxxx"

End Sub