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