+

VB开发的ERP系统

        KeyAscii = 0
   End Select
End Sub

'******************************************************************************************************************************
'*过程说明：事件
'*过程名称：Form_Load
'*功能描述：窗体载入
'*参数说明：
'******************************************************************************************************************************
Private Sub Form_Load()
   Screen.MousePointer = 11
  '定义可变部分变量
  '调入打印页面设置窗体

  '调 入 网 格
  GridCode = "MRP_BuildDepDemand"
  Call BzWgcsh(CxbbGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
  Qslz = GridInf(1)
  Sjhgd = GridInf(2)
  Szzls = CxbbGrid.Cols - 1
  
  '填 充 网 格
   Call Cxnrtcwg
   Screen.MousePointer = 0
   
   
 End Sub

'******************************************************************************************************************************
'*过程说明：自定义子程序
'*过程名称：Cxnrtcwg
'*功能描述：查 询 内 容 填 充 网 格
'*参数说明：
'******************************************************************************************************************************
Private Sub Cxnrtcwg()
    Dim Sqlstr As String
    Dim jsqte As Long, sMonthCyc As String, i As Integer, iYear As Integer, iMonth As Integer
    
    On Error GoTo Errhand
    
    '列出所有的月计划
    Me.CxbbGrid.Clear 1
    Sqlstr = "Select * From Gy_kjrlb Where (kjYear>'" & Year(Xtrq) & "' ) or ( kjYear='" & Year(Xtrq) & "' And Period>='" & Month(Xtrq) & "' ) Order by kjYear ,Period"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If Not RecTemp.EOF Then
        RecTemp.MoveLast: RecTemp.MoveFirst: jsqte = CxbbGrid.FixedRows
        CxbbGrid.Rows = CxbbGrid.FixedRows + Val(RecTemp.RecordCount)
        Do While Not RecTemp.EOF
            CxbbGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = Trim(Str(RecTemp!kjyear)) + "." + Format(Trim(Str(RecTemp!Period)), "00")
            CxbbGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = Format(RecTemp!Qsrq, "yyyy-mm-dd")
            CxbbGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = Format(RecTemp!Zzrq, "yyyy-mm-dd")
            CxbbGrid.TextMatrix(jsqte, Sydz("004", GridStr(), Szzls)) = Fun_GetCycState(Val(RecTemp!kjyear), Val(RecTemp!Period))
            RecTemp.MoveNext
            jsqte = jsqte + 1
        Loop
    End If

    Exit Sub
Errhand:
    If Err.Number = "-2147217871" Then
        Tsxx = "连接超时 , 请稍后重新进入!"
    Else
        Tsxx = "初始化过程发生未知错误，请稍后重新进入!"
    End If
    Me.Show
    Me.Refresh
    DoEvents
    Call Xtxxts(Tsxx, 0, 1)
End Sub

'返回某个周期状态，从而知道该周期是否需要汇总
Function Fun_GetCycState(iYear As Integer, iMonth As Integer) As String
    Dim RecState As New ADODB.Recordset, Sqls As String
    
    Sqlstr = "Select Count(*) From MRP_DependentDemandMain Where kjYear='" & iYear & "' And Period='" & iMonth & "' And Checker<>'' And IfTotal=0 And IfComplete=0 "
    Set RecState = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If RecState.Fields(0) <> 0 Then
        Fun_GetCycState = "需要汇总"
        Exit Function
    End If
    
    Sqlstr = "Select Count(*) From MRP_IndependentDemandMain Where kjYear='" & iYear & "' And Period='" & iMonth & "' And Checker<>'' And IfTotal=0 And IfComplete=0 "
    Set RecState = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If RecState.Fields(0) <> 0 Then
        Fun_GetCycState = "需要汇总"
        Exit Function
    End If
    
    Fun_GetCycState = "不需汇总"
    Set RecState = Nothing
End Function



Private Sub Form_Unload(Cancel As Integer)             '窗体卸载
   Set Cxnrrec = Nothing
   Set RecTemp = Nothing
   Unload Dyymctbl
End Sub

'******************************************************************************************************************************
'*过程说明：自定义程序
'*过程名称：cmd_Ok_Click
'*功能描述：根据所选计划周期对该计划周期内的相关与独立需求进行汇总
'*参数说明：
'******************************************************************************************************************************
Private Sub cmd_Ok_Click()
    Dim sCycStr As String, iYear As Integer, iMonth As Integer, RecBOM As New ADODB.Recordset
    
    If CxbbGrid.Row < CxbbGrid.FixedRows Then Exit Sub
    
    If Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("004", GridStr(), Szzls))) = "不需汇总" Then
        Tsxx = "该周期不需要汇总!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    End If
    sCycStr = CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("001", GridStr(), Szzls))
    Call Sub_DivMonth(sCycStr, iYear, iMonth)
     
    On Error GoTo Errhand
    
    Cw_DataEnvi.DataConnect.Errors.Clear
    Cw_DataEnvi.DataConnect.BeginTrans
    
    Screen.MousePointer = 11
    Dim c As New ADODB.Command:     Dim p  As ADODB.Parameter
    
    c.ActiveConnection = Cw_DataEnvi.DataConnect
    c.CommandType = adCmdStoredProc
    c.CommandText = "MRP_Sp_TotalSum"
    Set p = c.CreateParameter("kjYear", adChar, adParamInput, 20)
    c.Parameters.Append p:      p.Value = iYear
    Set p = c.CreateParameter("Period", adChar, adParamInput, 20)
    c.Parameters.Append p:          p.Value = iMonth
    Set p = c.CreateParameter("Czymc", adChar, adParamInput, 20)
    c.Parameters.Append p: p.Value = Xtczy
    Set p = c.CreateParameter("Czrq", adChar, adParamInput, 20)
    c.Parameters.Append p: p.Value = Format(Xtrq, "yyyy-mm-dd")
    Set p = c.CreateParameter("BillCode", adChar, adParamInput, 20)
    c.Parameters.Append p: p.Value = "2405"
    Set p = c.CreateParameter("Status", adInteger, adParamOutput)
    c.Parameters.Append p
    c.Execute
    If c.Parameters(5) = 0 Then
        Tsxx = "该周期内没有可以汇总物料!"
        Call Xtxxts(Tsxx, 0, 1)
        Cw_DataEnvi.DataConnect.RollbackTrans
        Screen.MousePointer = 0
        Exit Sub
    ElseIf c.Parameters(4) = 2 Then
        GoTo Errhand
    End If
    
    Cw_DataEnvi.DataConnect.CommitTrans
    Tsxx = "汇总完成!"
    Call Xtxxts(Tsxx, 0, 4)
    
    Screen.MousePointer = 0
    CxbbGrid.TextMatrix(CxbbGrid.Row, Sydz("004", GridStr(), Szzls)) = "不需汇总"
    Exit Sub
Errhand:
    Screen.MousePointer = 0
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "汇总过程出现未知错误，没有进行汇总，数据恢复!"
    Call Xtxxts(Tsxx, 0, 4)
    Exit Sub
End Sub
 
'******************************************************************************************************************************
'*过程说明：自定义程序
'*过程名称：Cmd_Cancel_Click
'*功能描述：取消操作，退成汇总程序
'*参数说明：
'******************************************************************************************************************************
Private Sub Cmd_Cancel_Click()
    Unload Me
End Sub


'*********************通用程序****************************************

Private Sub bbyl(bbylte As Boolean)                    '报表打印预览
  Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
  Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
  Bbxbtgs = 1                                          '报 表 小 标 题 行 数
  Bbbwhgs = 0                                          '报 表 表 尾 行 数
  ReDim Bbxbt(1 To Bbxbtgs)
  ReDim bbxbtzzxs(1 To Bbxbtgs)
  If Bbbwhgs <> 0 Then
     ReDim Bbbwh(1 To Bbbwhgs)
     ReDim Bbbwhzzxs(1 To Bbbwhgs)
  End If
  Bbzbt = ReportTitle
  Bbxbt(1) = " "
  bbxbtzzxs(1) = 0                                     '报表行组织形式(0-居左 1-居中 2-居右)
  Call Scyxsjb(CxbbGrid)                               '生成报表数据
  Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
  If Not bbylte Then
     Unload DY_Tybbyldy
  End If
End Sub

Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
        Case "bz"
            Call F1bz
        Case "tc"
            Unload Me
    End Select
End Sub

'拆分周期，从周期中提出年月
Private Sub Sub_DivMonth(InPara As String, Out1 As Integer, Out2 As Integer)
    Dim Pos1 As Integer
    Pos1 = InStr(1, InPara, ".")
    Out1 = Val(Left(InPara, Pos1 - 1))
    Out2 = Right(InPara, Len(InPara) - Pos1)
End Sub

Function Fun_NumericLen(Num As Double) As Integer
    Dim sNum As String
    sNum = Str(Int(Num))
    Fun_NumericLen = Len(Trim(sNum))
End Function