bos_balancelist.cls

金蝶地磅称重插件

    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  " & vbCrLf & _
            "where t_ST_SC_BalanceBill.FBillstatus=-1 " & 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")) & ",1"
                 
            Case "-83"
                  strsqllast = strsqllast & vbCrLf & "exec ReWriteSeoutstock " & CLng(rs.Fields("FID_SRC")) & "," & CLng(rs.Fields("FEntryID_SRC")) & "," & CDbl(rs.Fields("FNetWeight")) & ",1"
            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=1,FAuxQty=FBalanceWeight/FChangeRate where FQty<=FBalanceWeight 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=1 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")) & ",1"
            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
ErrUnDropBills:
    Set vec_seleBill = Nothing
    Set dic_seleBill = Nothing
    MsgBox err.Description, vbCritical, "金蝶提示"

    

End Sub


Private Sub m_ListInterface_MenuBarInitialize(ByVal oMenuBar As K3ClassEvents.MenuBar)
   
    Dim oTool   As K3ClassEvents.BOSTool
    Dim oBand   As K3ClassEvents.BOSBand
 
'*************** 开始新增 BOS 菜单 ***************
 
    '新增 取皮重 菜单对象，并设置属性
    Set oTool = oMenuBar.BOSTools.Add("mnuGetTareWeight")
    With oTool
        .Caption = "皮重"
        .ToolTipText = "皮重"
        .Description = "皮重"

        .ShortcutKey = 3
        .Visible = True
        .Enabled = True
        .BeginGroup = False
        '.ToolPicture = "C:\Documents and Settings\liwei\桌面\取数2.bmp"
        .ToolPicture = App.Path & "\get.ico"
        .SetPicture 0, vbButtonFace
    End With
 
    Set oBand = oMenuBar.BOSBands("BandToolBar")
    oBand.BOSTools.InsertAfter "mnuCaculate", oTool '将菜单对象插入指定工具栏
     '新增 删除 菜单对象，并设置属性
      Set oTool = oMenuBar.BOSTools.Add("mnuDelete")
        With oTool
            .Caption = "删除"
            .ToolTipText = "删除一次过磅记录"
            .Description = "删除"
    
            .ShortcutKey = 3
            .Visible = True
            .Enabled = True
            .BeginGroup = False
            '.ToolPicture = "C:\Documents and Settings\liwei\桌面\取数2.bmp"
            .ToolPicture = App.Path & "\Delete.ico"
            .SetPicture 0, vbButtonFace
        End With
     
        Set oBand = oMenuBar.BOSBands("BandToolBar")
        oBand.BOSTools.InsertBefore "mnuFilePreview", oTool   '将菜单对象插入指定工具栏
     
      '新增 作废 菜单对象，并设置属性
      Set oTool = oMenuBar.BOSTools.Add("mnuDrop")
        With oTool
            .Caption = "作废"
            .ToolTipText = "作废"
            .Description = "作废"
    
            .ShortcutKey = 3
            .Visible = True
            .Enabled = True
            .BeginGroup = False
            '.ToolPicture = "C:\Documents and Settings\liwei\桌面\取数2.bmp"
            .ToolPicture = App.Path & "\Drop.ico"
            .SetPicture 0, vbButtonFace
        End With
     
        Set oBand = oMenuBar.BOSBands("BandToolBar")
        oBand.BOSTools.InsertBefore "mnuEditModify", oTool      '将菜单对象插入指定工具栏
        
      '新增 反作废 菜单对象，并设置属性
      Set oTool = oMenuBar.BOSTools.Add("mnuUnDrop")
        With oTool
            .Caption = "反作废"
            .ToolTipText = "反作废"
            .Description = "反作废"
    
            .ShortcutKey = 3
            .Visible = True
            .Enabled = True
            .BeginGroup = False
            '.ToolPicture = "C:\Documents and Settings\liwei\桌面\取数2.bmp"
            .ToolPicture = App.Path & "\UnDrop.ico"
            .SetPicture 0, vbButtonFace
        End With
     
        Set oBand = oMenuBar.BOSBands("BandToolBar")
        oBand.BOSTools.InsertAfter "mnuEditModify", oTool       '将菜单对象插入指定工具栏
 
    '*************** 开始设置 BOS 原有菜单 ***************
    '隐藏“下推”菜单
    Set oBand = oMenuBar.BOSBands("menu")
    Set oTool = oBand.BOSTools("mnuPushBill")
    With oTool
        .Visible = False
        .Enabled = True
    End With
    
    '隐藏“上查”工具档按钮
    Set oBand = oMenuBar.BOSBands("BandToolBar")
    Set oTool = oBand.BOSTools("mnuDataViewPrvBill")
    With oTool
        .Visible = False
        .Enabled = True
    End With
 
    '隐藏“下查”工具档按钮
    Set oBand = oMenuBar.BOSBands("BandToolBar")
    Set oTool = oBand.BOSTools("mnuDataViewNextBill")
    With oTool
        .Visible = False
        .Enabled = True
    End With
'*************** 结束设置 BOS 原有菜单 ***************
'*************** 结束新增 BOS 菜单 ***************
    Set oBand = oMenuBar.BOSBands("mnuPop")
    Set oTool = oBand.BOSTools("mnuEditDelete")
    With oTool
        .Visible = False
        .Enabled = False
    End With

''选单序时隐藏按钮
If m_ListInterface.List.ShowMode = 2 Then   '选单

    '获得 mnuPushBill 菜单对象，并设置属性
    '删除
    Set oBand = oMenuBar.BOSBands("BandToolBar")
    Set oTool = oBand.BOSTools("mnuDelete")
    With oTool
        .Visible = False
        .Enabled = False
    End With

    '获得 mnuPushBill 菜单对象，并设置属性
    '作废
    Set oBand = oMenuBar.BOSBands("BandToolBar")
    Set oTool = oBand.BOSTools("mnuDrop")
    With oTool
        .Visible = False
        .Enabled = False
    End With

    '获得 mnuPushBill 菜单对象，并设置属性
    '反作废
    Set oBand = oMenuBar.BOSBands("BandToolBar")
    Set oTool = oBand.BOSTools("mnuUnDrop")
    With oTool
        .Visible = False
        .Enabled = False
    End With

    '获得 mnuPushBill 菜单对象，并设置属性
    '皮重
    Set oBand = oMenuBar.BOSBands("BandToolBar")
    Set oTool = oBand.BOSTools("mnuGetTareWeight")
    With oTool
        .Visible = False
        .Enabled = False
    End With
End If
End Sub
'质检用

'序时簿事件
'××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××
'××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××××
Private Sub m_ListInterface_AfterSelList(ByVal RsId As ADODB.Recordset, VectList As KFO.Vector)
    ''序时簿选择之后触发
    ''清空变量
    Dim i As Long
    Dim BalanceBillId As String
    BalanceBillId = ""
    
    Set Vector_SelectBill = VectList                '给选单向量赋值
    
    ''给选单字典赋值
    For i = VectList.LBound To VectList.UBound
        BalanceBillId = BalanceBillId & VectList(i).GetValue("FID") & ","
    Next
    
    ''调用存储过程判断检斤单号
    If Trim(BalanceBillId) <> "" Then
        BalanceBillId = Left(BalanceBillId, Len(BalanceBillId) - 1)
        Set rs = m_ListInterface.K3Lib.GetData("exec BjSp_BalanceCheckResult '" & BalanceBillId & "'")
    End If
    If Not rs.EOF Then
        If rs.Fields(1) = 1 And QM_Select = False Then
            MsgBox "不允许选择多个物料、供应商、客户、发料仓库、发料部门、收料仓库或收料部门！", , "金蝶提示"
        End If
        If QM_Select = False And Balance_Select = False Then
           If rs.Fields(0) <> "" Then
              MsgBox "所选单中以下单据没有质检：" & vbCrLf & Left(rs.Fields(0) & "", Len(rs.Fields(0) & "") - 1) & "", , "金蝶提示"
           End If
        End If
    End If
End Sub