bos_balancelist.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_BalanceList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Description = "This is ListEvents Interface Class, made by K3BOSPLUGINSWIZAED"
'************************************************************************
'2005－11－04 李伟
'检斤单叙事薄插件，
'功能：检斤单的作废，反作废，删除一次过磅单据，和工艺检斤的集体回皮
'************************************************************************
'定义 ListEvents 接口. 必须具有的声明, 以此来获得事件
Private WithEvents m_ListInterface  As ListEvents
Attribute m_ListInterface.VB_VarHelpID = -1
 
Private Sub DropBills()                     '作废单据 作废条件：单据状态为正常，没有被物理检验单，扣杂单引用
    On Error GoTo ErrDropBills              '作废后如果涉及到上游单据，要将上游单据的检斤重量减下来
    Dim vec_seleBill As KFO.Vector
    Dim dic_seleBill As KFO.Dictionary
    Dim lCount As Long
    Dim strsqlCondition As String
    Dim strSql As String
    Dim strsqllast As String
    Set vec_seleBill = m_ListInterface.GetSelectedBillInfo
    strsqlCondition = ""
    For lCount = vec_seleBill.LBound To vec_seleBill.UBound
        Set dic_seleBill = vec_seleBill.Item(lCount)
         strsqlCondition = strsqlCondition & dic_seleBill.GetValue("FID") & ","
        
    Next
    strsqlCondition = Mid(strsqlCondition, 1, Len(strsqlCondition) - 1)
    
    strSql = "select t_ST_SC_BalanceBill.FID,t_ST_SC_BalanceBill.FBillNo from t_ST_SC_BalanceBill  join t_ST_SC_BalanceBillentry" & vbCrLf & _
            "on t_ST_SC_BalanceBill.FID=t_ST_SC_BalanceBillEntry.FId and t_ST_SC_BalanceBillEntry.FnetWeight<>0 and" & vbCrLf & _
            "t_ST_SC_BalanceBill.FBillstatus=1 and t_ST_SC_BalanceBill.FStatus_WL=0 and t_ST_SC_BalanceBillEntry.FDeductWeight=0 " & vbCrLf & _
            "and t_ST_SC_BalanceBill.FID in " & vbCrLf & _
            "(" & strsqlCondition & ") "
     Set rs = m_ListInterface.K3Lib.GetData(strSql)
     If rs.EOF Then MsgBox "没有符合条件的单据", vbInformation, "金蝶提示": Exit Sub
     strsqlCondition = ""
     Do Until rs.EOF
        strsqlCondition = strsqlCondition & rs.Fields("FID") & ","
        strMsg = strMsg & rs.Fields("FBillNo") & vbCrLf
        rs.MoveNext
        
     Loop
     strsqlCondition = Mid(strsqlCondition, 1, Len(strsqlCondition) - 1)
     strSql = "Update t_ST_SC_BalanceBill set FBillstatus=-1 where FID in ( " & strsqlCondition & ")"
     m_ListInterface.K3Lib.GetData (strSql)
      ''2005-08-12 添加作废事对原单检斤数量的回写
     strSql = "Select FClassID_SRC,FID_SRC,FEntryID_SRC,FNetWeight/1000 as FNetWeight  from t_ST_SC_BalanceBillentry where FID in ( " & strsqlCondition & ")"
     Set rs = m_ListInterface.K3Lib.GetData(strSql)
     Do Until rs.EOF
        Select Case rs.Fields("FClassID_SRC")
            Case "-71"
                 strsqllast = strsqllast & vbCrLf & "exec RewritePOOrderEntry " & CLng(rs.Fields("FID_SRC")) & "," & CLng(rs.Fields("FEntryID_SRC")) & "," & CDbl(rs.Fields("FNetWeight")) & ",2"
                 
            Case "-83"
                  strsqllast = strsqllast & vbCrLf & "exec ReWriteSeoutstock " & CLng(rs.Fields("FID_SRC")) & "," & CLng(rs.Fields("FEntryID_SRC")) & "," & CDbl(rs.Fields("FNetWeight")) & ",2"
            Case "200000137"
                  strsqllast = strsqllast & vbCrLf & "Update  ICStockBillOrderEntry Set  FBalanceWeight=FBalanceWeight-" & CDbl(rs.Fields("FNetWeight")) & " where FID=" & CLng(rs.Fields("FID_SRC")) & vbCrLf & _
                                "and FEntryID=" & CLng(rs.Fields("FEntryID_SRC")) & vbCrLf & _
                                "UPdate ICStockBillOrderEntry set FClose=0 where FQty>=FBalanceWeight and FID=" & CLng(rs.Fields("FID_SRC")) & vbCrLf & _
                                "and FEntryID=" & CLng(rs.Fields("FEntryID_SRC")) & vbCrLf & _
                                "Update ICStockBillOrderEntry Set FAuxQty=FBalanceWeight/FChangeRate where FChangeRate>0 and FID=" & CLng(rs.Fields("FID_SRC")) & vbCrLf & _
                                "and FEntryID=" & CLng(rs.Fields("FEntryID_SRC"))
                    
            Case "200000160"
                  strsqllast = strsqllast & vbCrLf & "Update  t_EP_PB_TransContractEntry Set  FBalanceQty=FBalanceQty-" & CDbl(rs.Fields("FNetWeight")) & " where FID=" & CLng(rs.Fields("FID_SRC")) & vbCrLf & _
                                "and FEntryID=" & CLng(rs.Fields("FEntryID_SRC")) & vbCrLf '由于运输协议不关闭，把下面的去掉
                                '"UPdate t_EP_PB_TransContractEntry set FBalanceClose=0 where FQty>=FBalanceQty and FID=" & CLng(rs.Fields("FID_SRC")) & vbCrLf & _
                                ''"and FEntryID=" & CLng(rs.Fields("FEntryID_SRC"))
            Case "-82"
                 strsqllast = strsqllast & vbCrLf & "exec ReWriteSeoutstock2 " & CLng(rs.Fields("FID_SRC")) & "," & CLng(rs.Fields("FEntryID_SRC")) & "," & CDbl(rs.Fields("FNetWeight")) & ",2"
            Case Else
        End Select
        rs.MoveNext
     Loop
    If Len(Trim(strsqllast)) <> 0 Then m_ListInterface.K3Lib.GetData (strsqllast)
    MsgBox "单据号为: " & strMsg & " 作废成功", vbInformation, "金蝶提示"
       
    Set vec_seleBill = Nothing
    Set dic_seleBill = Nothing
    Exit Sub
ErrDropBills:
    Set vec_seleBill = Nothing
    Set dic_seleBill = Nothing
    MsgBox err.Description, vbCritical, "金蝶提示"

End Sub

Public Sub Show(ByVal oListInterface As Object)
    'ListEvents 接口实现
    '注意: 此方法必须存在, 请勿修改
    Set m_ListInterface = oListInterface
End Sub

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

Private Sub m_ListInterface_MenuBarClick(ByVal BOSTool As K3ClassEvents.BOSTool, Cancel As Boolean)
    Select Case BOSTool.ToolName
    Case "mnuGetTareWeight"
        '此处添加处理 取皮重 菜单对象的 Click 事件
         SetTareWeight       '为工艺过磅的一次回皮
    Case "mnuDelete"
         DeleteOnceBalance  '删除一次过磅单据
    Case "mnuDrop"
         DropBills          '作废单据
    Case "mnuUnDrop"
         UnDropBills        '反作废单据
    Case Else
    End Select
End Sub
Private Sub DeleteOnceBalance()                                             '删除一次过磅记录，条件：单据状态为未完成
    On Error GoTo errdelete
    Dim vec_seleBill As KFO.Vector
    Dim dic_seleBill As KFO.Dictionary
    Dim lCount As Long
    Dim strsqlCondition As String
    Dim strSql As String
    Dim strMsg As String
    Dim rs As New ADODB.Recordset
    Set vec_seleBill = m_ListInterface.GetSelectedBillInfo
    strsqlCondition = ""
    For lCount = vec_seleBill.LBound To vec_seleBill.UBound
        Set dic_seleBill = vec_seleBill.Item(lCount)
        strsqlCondition = strsqlCondition & dic_seleBill.GetValue("FID") & ","
        
    Next
    strsqlCondition = Mid(strsqlCondition, 1, Len(strsqlCondition) - 1)
    strSql = "select t_ST_SC_BalanceBill.FId,t_ST_SC_BalanceBill.FBIllNo,t_ST_SC_BalanceBill.FCarNO from t_ST_SC_BalanceBill,t_ST_SC_BalanceBillEntry" & vbCrLf & _
            "Where t_ST_SC_BalanceBill.FID = t_ST_SC_BalanceBillEntry.FID And t_ST_SC_BalanceBillEntry.FNetWeight = 0" & vbCrLf & _
           " And t_ST_SC_BalanceBill.FID" & vbCrLf & _
            "in" & vbCrLf & _
            "(" & strsqlCondition & ")"
     Set rs = m_ListInterface.K3Lib.GetData(strSql)
     If rs.EOF Then MsgBox "没有符合条件的单据", vbInformation, "金蝶提示": Exit Sub
     If MsgBox("是否删除当前车号为：：" & rs.Fields("FCarNO") & " 的单据？", vbYesNo + vbQuestion, "金蝶提示") = vbNo Then
        Exit Sub
     End If
     strsqlCondition = ""
     Do Until rs.EOF
        strsqlCondition = strsqlCondition & rs.Fields("FID") & ","
        strMsg = strMsg & rs.Fields("FBillNo") & vbCrLf
        rs.MoveNext
        
     Loop
      strsqlCondition = Mid(strsqlCondition, 1, Len(strsqlCondition) - 1)
      strSql = "Delete From t_ST_SC_BalanceBill where t_ST_SC_BalanceBill.FID in ( " & strsqlCondition & ")" & vbCrLf & _
                "Delete From t_ST_SC_BalanceBillEntry where t_ST_SC_BalanceBillEntry.FID in ( " & strsqlCondition & ")"
      m_ListInterface.K3Lib.GetData (strSql)
      MsgBox "单据号为: " & strMsg & " 删除成功", vbInformation, "金蝶提示"
      Set vec_seleBill = Nothing
     Set dic_seleBill = Nothing
     Set rs = Nothing
     Exit Sub
    
errdelete:
     MsgBox err.Description, vbCritical, "金蝶提示"
     Set vec_seleBill = Nothing
     Set dic_seleBill = Nothing
     
     
            
End Sub

Private Sub SetTareWeight()                                                             '为工艺回皮统一设置皮重
    On Error GoTo errSetTareWeight '同一个车号的，都是工艺检斤的，可以在叙事薄里一起回皮
    Dim vec_seleBill As KFO.Vector
    Dim dic_seleBill As KFO.Dictionary
    Dim rs           As New ADODB.Recordset
    Dim lCount As Long
    Dim strSql As String
    Dim strsqlCondition As String
    Dim dblTareWeight As Double
    Dim strCarNo As String

    Dim strTareOP As String
    strTareOP = m_ListInterface.K3Lib.User.UserName
    
   
    strsqlCondition = ""
    Set vec_seleBill = m_ListInterface.GetSelectedBillInfo
    For lCount = vec_seleBill.LBound To vec_seleBill.UBound
        Set dic_seleBill = vec_seleBill.Item(lCount)
         strsqlCondition = strsqlCondition & " FID= " & dic_seleBill.GetValue("FID") & " Or "
        
    Next
    strsqlCondition = Mid(strsqlCondition, 1, Len(strsqlCondition) - 3)
    strSql = "select distinct FcarNO,FBillType from t_ST_SC_BalanceBill where " & strsqlCondition
    Set rs = m_ListInterface.K3Lib.GetData(strSql)
    If rs.EOF Then MsgBox "在选择的单据中未找到调拨单据", vbInformation, "金蝶提示": Exit Sub
  
    
    If rs.RecordCount > 1 Then MsgBox "您选择了多个车号或多种单据类型，请从新选择", vbInformation, "金蝶提示": Exit Sub
    If rs.Fields(1) <> 5 Then MsgBox "您选择的不是工艺检斤", vbInformation, "金蝶提示": Exit Sub
    strCarNo = Trim(rs.Fields("FCarNO"))
    strSql = "Select FBillNo, FBillStatus from t_ST_SC_BalanceBill where " & strsqlCondition
    Set rs = m_ListInterface.K3Lib.GetData(strSql)
    Do Until rs.EOF
        If rs.Fields(1) <> "0" Then
            Select Case rs.Fields(1)
                Case "-1"
                    MsgBox "单据编号为: " & rs.Fields(0) & " 已经作废,请去掉该单据!", vbInformation, "金蝶提示"
                Case Else
                    MsgBox "单据编号为: " & rs.Fields(0) & " 已经完成过皮,请去掉该单据!", vbInformation, "金蝶提示"
            End Select
            Exit Sub
        End If
        rs.MoveNext
    Loop
    strSql = "Select FTareWeight from t_BalanceItem where FItemName='" & strCarNo & "'" & " and Ftype=3"
    Set rs = m_ListInterface.K3Lib.GetData(strSql)
    If rs.EOF Then MsgBox "在车辆基础资料中没有此车的皮重信息", vbInformation, "金蝶提示": Exit Sub
    dblTareWeight = rs.Fields(0)
    
    strSql = "Update t_ST_SC_BalanceBillEntry set FTareWeight=" & dblTareWeight & ",FTareBalanceTime=getdate(),FNetWeight=FGrossWeight-" & dblTareWeight & "," & vbCrLf & _
                "FTareOP='" & strTareOP & "' where " & strsqlCondition & vbCrLf & _
                "update t_ST_SC_BalanceBill set FBillstatus=1 where " & strsqlCondition
    m_ListInterface.K3Lib.GetData (strSql)
    MsgBox " 操作完成", vbInformation, "金蝶提示"
  
    Exit Sub
errSetTareWeight:
   
    MsgBox err.Description, vbCritical, "错误"
End Sub
'反作废单据，条件是已经做费，作废后如果涉及到上游单据，要把重量累计到上游单据的已检斤重量上
Private Sub UnDropBills()

     On Error GoTo ErrUnDropBills
    Dim vec_seleBill As KFO.Vector
    Dim dic_seleBill As KFO.Dictionary
    Dim lCount As Long
    Dim strsqlCondition As String
    Dim strSql As String
    Dim strsqllast As String
    Set vec_seleBill = m_ListInterface.GetSelectedBillInfo
    strsqlCondition = ""
    For lCount = vec_seleBill.LBound To vec_seleBill.UBound
        Set dic_seleBill = vec_seleBill.Item(lCount)
         strsqlCondition = strsqlCondition & dic_seleBill.GetValue("FID") & ","