bos_othercomp.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_OtherComp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'''''''''''''''''''''''''''''''''''''''''''''''
''其它数据结算
''建立日期：2005-07-28
''建立人：倪树祥
'''''''''''''''''''''''''''''''''''''''''''''''''
'定义 BillEvent 接口. 必须具有的声明, 以此来获得事件
Private WithEvents m_BillInterface  As BillEvent
Attribute m_BillInterface.VB_VarHelpID = -1
'定义 ListEvents 接口. 必须具有的声明, 以此来获得事件
Private WithEvents m_ListInterface  As ListEvents
Attribute m_ListInterface.VB_VarHelpID = -1

Public Sub Show(ByVal oBosInterface As Object)
    'BillEvent 接口实现
    '注意: 此方法必须存在, 请勿修改
    Select Case VBA.TypeName(oBosInterface)
    Case "BillEvent"
        Set m_BillInterface = oBosInterface
    Case "ListEvents"
        Set m_ListInterface = oBosInterface
    End Select
End Sub

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

Private Sub m_BillInterface_AfterSave(ByRef bCancel As Boolean)
'回写计算结果
On Error GoTo Errhandle

    Dim rsRec As New Recordset
    Set rsRec = m_BillInterface.K3Lib.GetData(" exec IC_SP_OtherComp " & m_BillInterface.CurBillID)
    If Not rsRec.EOF Then
        m_BillInterface.SetFieldValue "FInvQty", rsRec("FInvQty")
        m_BillInterface.SetFieldValue "FAvgPrice", rsRec("FInvAmount") / rsRec("FInvQty")
        m_BillInterface.SetFieldValue "FInvAmount", rsRec("FInvAmount")
        m_BillInterface.SetFieldValue "FTransFeeAmount", rsRec("FTransFeeAmount")
    End If
    Set rsRec = Nothing
    
    m_BillInterface.RefreshBill
    
Errhandle:
    
End Sub

Private Sub m_BillInterface_AfterSelBill(ByVal lSelBillType As Long)
''选单之后触发
    Dim iCurrSel As Long
    Dim strTemp As String
    Dim lngCurrFID As Long
    Dim sBID As String
    Dim rsRec As New Recordset
    Dim sCurrBID As String
    
    On Error GoTo Errhandle
    
    sBID = ""
    '设置物料信息,得到所有的捡斤单ID
    Dim Dic_SelectTemp As KFO.Dictionary
    If lSelBillType = 200000126 Then Exit Sub '如果是选择结算版本，则不进行任何处理
    For iCurrSel = Vector_SelectBill.LBound To Vector_SelectBill.UBound
        Set Dic_SelectTemp = Vector_SelectBill(iCurrSel)
        sCurrBID = Dic_SelectTemp.GetValue("FID")
        
        If sCurrBID <> "" Then
           If sBID <> "" Then
                sBID = sBID & ","
           End If
           sBID = sBID & sCurrBID
        Else
           Exit For
        End If
    Next
    
    InsertBillDetail sBID '填写入库单信息
    
    Set rsRec = m_BillInterface.K3Lib.GetData("exec IC_SP_OtherCompSel  '" & sBID & "'")
    If Not rsRec.EOF Then
       m_BillInterface.SetFieldValue "FInQty", rsRec("FNetWeight")                             '净重
       m_BillInterface.SetFieldValue "FSelfQty", rsRec("FNetWeight")                             '净重
       m_BillInterface.SetFieldValue "FVolume", rsRec("FEditionNo")                             '版本
       m_BillInterface.SetFieldValue "FMItem", rsRec("FMItemNumber")                             '物料
       m_BillInterface.SetFieldValue "FSupplier", rsRec("FSuppNumber")                             '供应商
       m_BillInterface.SetFieldValue "FInPrice", rsRec("FPrice")                             '单价
       
       
    m_BillInterface.DeleteEntryData 2
    iCurrSel = 1
    If Not rsRec.EOF Then
        While Not rsRec.EOF
             If iCurrSel <= rsRec.RecordCount Then
                m_BillInterface.InsertNewRowAndFill 2, iCurrSel, "FCheckItem", rsRec("FItemNumber"), "FBaseValue", rsRec("FBaseValue"), "FInputValue", rsRec("FValue")   '插入一个新行.

             End If
             rsRec.MoveNext
             iCurrSel = iCurrSel + 1
        Wend
    End If
       
    End If
    
    Exit Sub
Errhandle:
    MsgBox "数据填充时发生错误！", vbOKOnly + vbInformation, "金蝶提示"
End Sub

Private Sub InsertBillDetail(sBalIDs As String)
    Dim iCurrSel As Long
    Dim strTemp As String
    Dim lngCurrFID As Long
    Dim sBID As String
    
    Dim rsRec As New Recordset

On Error GoTo Errhandle

       
    '填写入库单信息
    strTemp = " select ICStockBill.FBillNo,ICStockBill.FDate,ICStockBillEntry.FBatchNo,t_Stock.FNumber,ICStockBillEntry.FQty,ICStockBillEntry.FEntrySelfA0155 as FInQtyNet ,ICStockBillEntry.FEntrySelfA0155 - ICStockBillEntry.FQty as FQtyDeducted " & _
                    " ,t_emp.FName as FKeeper,t_emp01.FName as FMChecker,t_User.FName as FBillChecker" & _
              " from ICStockBill inner join ICStockBillEntry on ICStockBill.FInterID = ICStockBillEntry.FInterID " & _
                     " inner join t_Stock on t_Stock.FItemID = icstockbillEntry.FDCStockID " & _
                     " inner join t_emp on ICStockBill.FSManagerID = t_emp.FItemID " & _
                     " inner join t_emp t_emp01 on ICStockBill.FFManagerID = t_emp01.FItemID " & _
                     " inner join t_User on ICStockBill.FCheckerID = t_User.FUserID " & _
              " where ((ICStockBillEntry.FSourceInterID in (" & sBalIDs & " ) and FSourceTranType ='200000109' ) " & _
                    " or ( ICStockBillEntry.FSourceInterID in (select distinct FID from t_ST_SC_BalMergeEntry1  where  FEntryID_SRC in (select distinct FEntryID from t_ST_SC_BalanceBillEntry where FID in (" & sBalIDs & " ))) and FSourceTranType ='200000194' ))" & _
                     " and ICStockBill.FCancellation = 0 " & _
              " order by ICStockBillEntry.FInterID"

    Set rsRec = m_BillInterface.K3Lib.GetData(strTemp)

    iCurrSel = 1

    m_BillInterface.DeleteEntryData 4
    If Not rsRec.EOF Then
        While Not rsRec.EOF
             If iCurrSel <= rsRec.RecordCount Then
                m_BillInterface.InsertNewRowAndFill 4, iCurrSel, "FStockInBillNo", rsRec("FBillNo"), "FBatchNo", rsRec("FBatchNo"), "FInWareDate", rsRec("FDate"), "FWareNo", rsRec("FNumber"), "FInWareQty", rsRec("FQty"), "FInQtyNet", rsRec("FInQtyNet"), "FQtyDeducted", rsRec("FQtyDeducted"), "FKeeper", rsRec("FKeeper"), "FMChecker", rsRec("FMChecker"), "FBillChecker", rsRec("FBillChecker")  '插入一个新行.

             End If
             rsRec.MoveNext
             iCurrSel = iCurrSel + 1
        Wend
    End If
    
    Exit Sub
Errhandle:
    MsgBox "数据填充时发生错误！", vbOKOnly + vbInformation, "金蝶提示"
End Sub