bos_rollback.cls

金蝶地磅称重插件

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Bos_rollback"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
 '**********************************************************************
 '2006-06-15 张健
 '卷板退货调整单的插件
 '功能：用于放在卷板退货调整单的插件中
 '**********************************************************************
Option Explicit
Private WithEvents m_BillInterface  As BillEvent
Attribute m_BillInterface.VB_VarHelpID = -1
Public tuityperow As String
Public sumbalance As Double
Dim aa() As String
Dim net1, net2 As Double
Public billno As String

Public Sub Show(ByVal oBillInterface As Object)

    'BillEvent 接口实现
    '注意: 此方法必须存在, 请勿修改
    Set m_BillInterface = oBillInterface
   
End Sub
Private Sub Class_Terminate()
    '释放接口对象
    '注意: 此方法必须存在, 请勿修改
    Set m_BillInterface = Nothing
  
End Sub



Private Sub m_BillInterface_AfterLoadBill()
m_BillInterface.LockBill
End Sub

Private Sub m_BillInterface_AfterSave(bCancel As Boolean)
    Dim i As Integer
    Dim strSql, qq, bb As String
    Dim rs, rt As ADODB.Recordset
    
    On Error GoTo errAfterSave
    '用frewriteflag来控制不能重多次保存所带来的对检斤单和自动生成销售出库单的操作
    qq = "select frewriteflag from t_rollback where fid=" & m_BillInterface.CurBillID
    Set rt = m_BillInterface.K3Lib.GetData(qq)
    If rt.Fields(0) = True Then Exit Sub
    

'生成一张红字销售出库单(以用于在删除卷板退货调整单时用并调整库存（红，蓝为0）)
'###########################################################

'先取出退货通知单中购货单位的ID , 以做下面存储过程的参数
    Dim cust, strcust As String
    Dim rscust As ADODB.Recordset
    Dim g_StrUser As Integer
    cust = m_BillInterface.GetFieldValue("fcustomer")
    g_StrUser = m_BillInterface.K3Lib.User.UserID
    strSql = "exec BjSp_Autooutstock_red 1," & m_BillInterface.CurBillID & "," & cust & "," & g_StrUser
    m_BillInterface.K3Lib.GetData (strSql)
'    bb = "update t_rollback set frewriteflag=1 where fid=" & m_BillInterface.CurBillID
'    m_BillInterface.K3Lib.GetData (bb)
'#####################################################################
''删除已自动生成的销售出库单
    Dim strroll, strroll1, strroll2, strroll3 As String
    Dim rsroll As ADODB.Recordset
'
'   '取出销售出库单单据内码Finterid
'    strroll1 = "select finterid from icstockbillentry where fsourcebillno='" & aa(1) & "'" & "and fnote='" & "zj系统出库" & "'"
'    Set rsroll = m_BillInterface.K3Lib.GetData(strroll1)
'
'    '删除销售出库单单据体
'    For i = 1 To UBound(aa)
'        strroll = "delete from icstockbillentry where fsourcebillno='" & aa(i) & "'" & "and fnote='" & "zj系统出库" & "'"
'        m_BillInterface.K3Lib.GetData (strroll)
'    Next
'    '删除销售出库单单据头
'     If Not rsroll.EOF Then
'        '由于不能删除已审核的单据，所以先将审核去掉
'        m_BillInterface.K3Lib.GetData ("update icstockbill set fcheckdate=null,fcheckerid=0 where finterid=" & rsroll.Fields("finterid"))
'        '删除单据头
'        strroll2 = "delete from icstockbill where finterid=" & rsroll.Fields("finterid")
'        m_BillInterface.K3Lib.GetData (strroll2)
'    End If
    
    '让本次所选检斤单下次不能再次被选，并将单据状态由“已出库(销售)-3”置为“已入库(产成品)-6”
    '，并且将Fmodifyflag改为0，以让其在下次销售出库时能选
    For i = 1 To UBound(aa)
        m_BillInterface.K3Lib.GetData ("update t_ST_SC_BalanceBill set frollbackflag=1,fbillstatus=-6,fmodifyflag=0 where fbillno='" & aa(i) & "'")
    Next
    '更新表t_rollback 中的Frewriteflag为1
    bb = "update t_rollback set frewriteflag=1 where fid=" & m_BillInterface.CurBillID
    m_BillInterface.K3Lib.GetData (bb)
    '回写退货通知单的相关字段，以钩稽让其自动关闭。
    strroll3 = "exec rollreturn  '" & billno & "' ," & net1
    m_BillInterface.K3Lib.GetData (strroll3)
    
    Exit Sub
    m_BillInterface.LockBill
errAfterSave:
    MsgBox err.Description, vbCritical, "金蝶提示"
    Set rs = Nothing
End Sub

Private Sub m_BillInterface_AfterSelBill(ByVal lSelBillType As Long)
    Dim rrz As ADODB.Recordset
    Dim xy1 As String
    m_BillInterface.LockBill
    m_BillInterface.BillHeads(1).BOSFields.Item("fcarno").FieldLock = False
    m_BillInterface.BillHeads(1).BOSFields.Item("fnote").FieldLock = False
    m_BillInterface.SetFieldValue "fsum", 0
    If m_BillInterface.GetFieldValue("fbillno_src") <> "" Then
        xy1 = "select fauxqty,fentryselfs1232 from vwicbill_33  where fbillno='" & m_BillInterface.GetFieldValue("fbillno_src") & "'" & "and fentryid=" & m_BillInterface.GetFieldValue("fentryid_src")
        Set rrz = m_BillInterface.K3Lib.GetData(xy1)
        If Not rrz.EOF Then
            m_BillInterface.SetFieldValue "fqty", rrz.Fields(0)
        End If
        billno = m_BillInterface.GetFieldValue("fbillno_src")
    End If
End Sub

Private Sub m_BillInterface_beforesave(bCancel As Boolean)
    Dim status As String
    Dim a As Integer
    With m_BillInterface
        If Not CheckMar() Then MsgBox "发货通知的物料与检斤单物料不同，请查找原因": bCancel = True: Exit Sub
        If Not calcnetweight() Then   'm_BillInterface.BillCtl.Data("page2").Size
            If MsgBox("由于所装卷板量比退货通知单所开的量多" & Str((net1 - net2) / 1000) & "吨，是否保存？", vbYesNo, "国丰提示") = vbNo Then
                bCancel = True
                Exit Sub
            End If
        End If
        If Len(.GetFieldValue("fcarno")) = 0 Then
            MsgBox "车号不能为空，请录入", vbInformation, "国丰提示"
            bCancel = True
            Exit Sub
        End If
   a = m_BillInterface.BillCtl.Data("Page3").Size
   ReDim aa(a)
   For a = 1 To a
        aa(a) = .GetFieldValue("fjianjinno", a)
   Next
        .SetFieldValue "fseinno", .GetFieldValue("fseinbillno")
        .SetFieldValue "FBase", .GetFieldValue("Fcustomer", , 2)
        .SetFieldValue "fsendstock1", .GetFieldValue("fstock", , 2)
        .SetFieldValue "fqty1", .GetFieldValue("fqty")
    End With
   m_BillInterface.SetFieldValue "fsum", sumbalance / 1000
End Sub

Private Function CheckMar() As Boolean   'ByVal lrow As Long
    Dim lrowcont As Long
    Dim StrMar1, strmar3 As String
    Dim strMar2 As String
    With m_BillInterface
        StrMar1 = .GetFieldValue("Fmar", 1)
        strmar3 = .GetFieldValue("Fmaterial1")
        If StrMar1 <> strmar3 Then
                CheckMar = False
                Exit Function
        End If
    End With
    CheckMar = True
End Function

Private Function calcnetweight() As Boolean   'ByVal lrow As Long
Dim rr As ADODB.Recordset
Dim strr, strtype1, strtype2 As String
Dim S_Key As String
Dim L_Index As Long
Dim kk, lrowcont As Long
Dim rr1 As ADODB.Recordset
Dim xy As String
With m_BillInterface
net1 = 0
net2 = 0
'取所选 检斤单净重合计
net1 = m_BillInterface.Sum(m_BillInterface.GetFieldInfoByKey("Fnetweight", S_Key, L_Index))
sumbalance = net1
'vwicbill_33代表退货通知，fauxqty代表退货数量，fentryselfs1232代表检斤重量
xy = "select fauxqty,fentryselfs1232 from vwicbill_33  where fbillno='" & .GetFieldValue("fbillno_src") & "'" & "and fentryid=" & .GetFieldValue("fentryid_src")
Set rr1 = .K3Lib.GetData(xy)
    'net2 = .GetFieldValue("fqty") * 1000
       'If net2 = 0 Then
       net2 = (rr1.Fields(0) - rr1.Fields(1)) * 1000
       If net1 > net2 Then
            
            calcnetweight = False
            Exit Function
            
        End If
End With
calcnetweight = True
End Function