批量核销



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