bos_selfcomp.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_SelfCompJF"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'''''''''''''''''''''''''''''''''''''''''''''''
''厂内数据结算-焦粉
''建立日期：2005-07-28
''建立人：倪树祥
'''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
'定义 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_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
    
    For iCurrSel = Vector_SelectBill.LBound To Vector_SelectBill.UBound
        Set Dic_SelectTemp = Vector_SelectBill(iCurrSel)
        sCurrBID = Dic_SelectTemp.GetValue("FID")
        If iCurrSel = Vector_SelectBill.LBound And sCurrBID <> "" Then
           Set rsRec = m_BillInterface.K3Lib.GetData("select t3.Fnumber,t1.FTeamGroup,t1.FCarNo from t_ST_SC_BalanceBill t1 left join t_ST_SC_BalanceBillentry t2 on t1.fid=t2.fid left join t_icitem t3 on t2.Fmateriel=t3.fitemid where t1.fid=" & sCurrBID)
           If Not rsRec.EOF Then
              m_BillInterface.SetFieldValue "FMItem", rsRec("FNumber")                             '物料
           End If
        End If
        If sCurrBID <> "" Then
           If sBID <> "" Then
                sBID = sBID & ","
           End If
           sBID = sBID & sCurrBID
        Else
           Exit For
        End If
    Next
    
    InsertBillDetail sBID '添加检斤单、扣杂单、质检单和入库单的信息
    
    '填写结算信息
    strTemp = " exec IC_SP_SelfCompJF ' " & sBID & "'"

    Set rsRec = m_BillInterface.K3Lib.GetData(strTemp)

    iCurrSel = 1

    m_BillInterface.DeleteEntryData 6
    If Not rsRec.EOF Then
            
        m_BillInterface.SetFieldValue "FCompDetail", rsRec("FCompDetail")
        m_BillInterface.SetFieldValue "FContractNo", rsRec("FContractNo")
        
        While Not rsRec.EOF
             If iCurrSel <= rsRec.RecordCount Then
                m_BillInterface.InsertNewRowAndFill 6, iCurrSel, "FDateScope", rsRec("FDateScope"), "FInDate", rsRec("FInDate"), "FInQty02", rsRec("FInQty"), "FDeductDis", rsRec("FDeductDis"), "FDeductDised", rsRec("FDeductDised"), "FWaterPer", rsRec("FWaterPer"), "FWaterDis", rsRec("FWaterDis"), "FWaterDised", rsRec("FWaterDised"), "FWayLostPer", rsRec("FWayLostPer"), "FCompQty", rsRec("FCompQty"), "FMPrice", rsRec("FMPrice"), "FTranPrice", rsRec("FTranPrice"), "FPriceSum", rsRec("FPriceSum"), "FCPercent", rsRec("FCPercent"), "FCDeltaPrice", rsRec("FCDeltaPrice"), "FSPercent", rsRec("FSPercent"), "FSDeltaPrice", rsRec("FSDeltaPrice"), "FCompPrice", rsRec("FCompPrice"), "FMAmount", rsRec("FMAmount"), "FMTranFee", rsRec("FMTranFee"), "FMAmountSum", rsRec("FMAmountSum"), "FInvAmount", rsRec("FInvAmount"), "FInvBillQty", rsRec("FInvBillQty"), "FTranFeeAmount", rsRec("FTranFeeAmount"), "FTransFeeBillQty", rsRec("FTransFeeBillQty") '插入一个新行.

             End If
             rsRec.MoveNext
             iCurrSel = iCurrSel + 1
        Wend
    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

    '填写扣杂单信息
    m_BillInterface.K3Lib.UpdateData ("exec Cg_SP_GetDeductMsg  '" & sBalIDs & "'")
    strTemp = " select DM.FDeductNo,DM.FBillNo,DM.FCarNo,isnull(A.FNumber,0) as FSItemID,B.FNumber as FQItemID,C.FNumber as FWItemID,DM.FTItemID,DM.FID,cast(DM.DQty as decimal(20,6)) as DQty,DM.Memo " & _
              "  from tmpDeductMsg DM " & _
                    " left outer join t_emp A on DM.FSItemID = A.FItemID " & _
                    " left outer join t_emp B on DM.FQItemID = B.FItemID " & _
                    " left outer join t_emp C on DM.FWItemID = C.FItemID " & _
               " order by DM.FID"
    Set rsRec = m_BillInterface.K3Lib.GetData(strTemp)
    
    iCurrSel = 1
    m_BillInterface.DeleteEntryData 3

    If Not rsRec.EOF Then
        While Not rsRec.EOF

             If iCurrSel <= rsRec.RecordCount Then
                m_BillInterface.InsertNewRowAndFill 3, iCurrSel, "FDeductBillNo", rsRec("FBillNo"), "FDeductCarNo", rsRec("FCarNo"), "FDeductNo", rsRec("FDeductNo"), "FSItemID", rsRec("FSItemID"), "FQItemID", rsRec("FQItemID"), "FWItemID", rsRec("FWItemID"), "FWDeduct", rsRec("DQty"), "FDMemo", rsRec("Memo") '插入一个新行.

             End If
             rsRec.MoveNext
             iCurrSel = iCurrSel + 1
        Wend
    End If
    
    '填写质检单信息
    m_BillInterface.K3Lib.UpdateData ("exec Cg_SP_GetQualityMsg  '" & sBalIDs & "'")
    'Set rsRec = m_BillInterface.K3Lib.GetData("exec Cg_SP_GetQualityMsg  '" & sBalIDs & "'")
    Set rsRec = m_BillInterface.K3Lib.GetData("select FBillNo, FBillDate,FCarNo, FRecDept,FQuantity, FQcMemo From tmpQualityMsg order by FID")
    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, "FQcBillNo", rsRec("FBillNo"), "FQcBillDate", rsRec("FBillDate"), "FQcCarNo", rsRec("FCarNo"), "FQcRecDept", rsRec("FRecDept"), "FQcQuantity", rsRec("FQuantity"), "FQcMemo", rsRec("FQcMemo") '插入一个新行.

             End If
             rsRec.MoveNext
             iCurrSel = iCurrSel + 1
        Wend
    End If
    
    '填写入库单信息
    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 5
    If Not rsRec.EOF Then
        While Not rsRec.EOF
             If iCurrSel <= rsRec.RecordCount Then
                m_BillInterface.InsertNewRowAndFill 5, iCurrSel, "FStockInBillNo", rsRec("FBillNo"), "FBatchNo", rsRec("FBatchNo"), "FInWareDate", rsRec("FDate"), "FWareNo", rsRec("FNumber"), "FInQty", 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



Private Sub m_ListInterface_MenuBarClick(ByVal BOSTool As K3ClassEvents.BOSTool, Cancel As Boolean)
    Dim lngFCheckerID As Long
    Dim lngFContractID As Long
    Dim sFBillStatus As String
    Dim rsRec As Recordset
    
 Select Case BOSTool.ToolName
    Case "mnuKP"
        lngFContractID = m_ListInterface.GetCurrentSelRowInfo("FID")
        sFBillStatus = "select fchecker,FBillStatus from t_EP_PB_SelfCompJF where FID  = " & lngFContractID
        Set rsRec = m_ListInterface.K3Lib.GetData(sFBillStatus)
        If Not rsRec.EOF Then
            lngFCheckerID = rsRec("fchecker")
            sFBillStatus = rsRec("FBillStatus")
        End If
       If sFBillStatus = "是" Then
            MsgBox "当前分录已经是未开票,不需再执行此操作！", vbOKOnly + vbInformation, "金蝶提示"
            Exit Sub
        Else
             If lngFCheckerID > 0 And sFBillStatus = "" Then
                  m_ListInterface.K3Lib.UpdateData "update  t_EP_PB_SelfCompJF set  FBillStatus = '是' where FID=" & lngFContractID
                  MsgBox "当前分录已成功设置开票状态！", vbInformation + vbOKOnly, "金蝶提示"
                  Exit Sub
             Else
                 MsgBox "当前分录还没有审核，不能设置开票操作！", vbOKOnly + vbInformation, "金蝶提示"
                 Exit Sub
            End If
        End If
    Case "mnuFKP"
        lngFContractID = m_ListInterface.GetCurrentSelRowInfo("FID")
        sFBillStatus = "select fchecker,FBillStatus from t_EP_PB_SelfCompJF where FID  = " & lngFContractID
        Set rsRec = m_ListInterface.K3Lib.GetData(sFBillStatus)
        If Not rsRec.EOF Then
            lngFCheckerID = rsRec("fchecker")
            sFBillStatus = rsRec("FBillStatus")
        End If
        
        If sFBillStatus = "" Then
            MsgBox "当前结算单没有设置开票状态，不能执行恢复操作！", vbOKOnly + vbInformation, "金蝶提示"
            Exit Sub
        Else
            m_ListInterface.K3Lib.UpdateData "update  t_EP_PB_SelfCompJF set  FBillStatus = '' where FID=" & lngFContractID
            MsgBox "当前结算单已成功恢复开票设置操作！", vbOKOnly + vbInformation, "金蝶提示"
         End If
    Case Else
    End Select
    
End Sub

Private Sub m_ListInterface_MenuBarInitialize(ByVal oMenuBar As K3ClassEvents.MenuBar)
 
    If m_ListInterface.List.ShowMode = 2 Then Exit Sub '如果是选单，则不创建新的菜单对象
    
    Dim oTool   As K3ClassEvents.BOSTool
    Dim oBand   As K3ClassEvents.BOSBand
 
'*************** 开始新增 BOS 菜单 ***************
 
    '新增 mnuZF 菜单对象，并设置属性
    Set oTool = oMenuBar.BOSTools.Add("mnuKP")
    With oTool
        .Caption = "开票"
        .ToolTipText = "开票"
        .Description = "开票"
        .ShortcutKey = 0
        .Visible = True
        .Enabled = True
        .BeginGroup = False
        .ToolPicture = App.Path & "\未命名.bmp"
        .SetPicture 0, vbButtonFace
    End With
 
    Set oBand = oMenuBar.BOSBands("BandToolBar")
    oBand.BOSTools.InsertAfter "mnuCaculate", oTool    '将菜单对象插入指定工具栏
 
    '新增 mnuFZF 菜单对象，并设置属性
    Set oTool = oMenuBar.BOSTools.Add("mnuFKP")
    With oTool
        .Caption = "恢复"
        .ToolTipText = "恢复"
        .Description = "恢复"
        .ShortcutKey = 0
        .Visible = True
        .Enabled = True
        .BeginGroup = False
        .ToolPicture = App.Path & "\未命名.bmp"
        .SetPicture 0, vbButtonFace
    End With
 
    Set oBand = oMenuBar.BOSBands("BandToolBar")
    oBand.BOSTools.InsertAfter "mnuCaculate", oTool '将菜单对象插入指定工具栏
 
 
'*************** 结束新增 BOS 菜单 ***************
 

End Sub