VB开发的ERP系统

    SqlStr = "Select Count(*) From gy_kjrlb where kjyear='" + Trim(Str(PrivateYear)) + "' And Period='" + CStr(PrivateMm) + "' " _
                    & "And CwzzJzbz='1'"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    If RecTemp.Fields(0) > 0 Then
        Call Sub_OperStatus("10")
    Else
        Call Sub_OperStatus("11")
    End If
    Lab_OperStatus.Caption = "1"
    If ShowBillLock = False Then
        Exit Sub
    End If
    '显示数据
    Call Sub_Query(Combo_Sort.ListIndex)
    
End Sub
Private Sub Combo_Sort_Click()              '选择排序
    If Combo_Sort.ListIndex = 1 Then
        CzxsGrid.ColHidden(Sydz("007", GridStr(), Szzls)) = False
    Else
        CzxsGrid.ColHidden(Sydz("007", GridStr(), Szzls)) = True
    End If
    Call CshCostOCenter(Combo_Sort.ListIndex)
    If ShowBillLock = True Then
        Call Sub_Query(Combo_Sort.ListIndex)
    End If
    
End Sub

Private Sub CzxsGrid_BeforeMoveColumn(ByVal Col As Long, Position As Long)
    Call FnBln_RefreshArray(Col, Position, GridStr(), GridInf())
End Sub

Private Sub CzxsGrid_EnterCell()
    With CzxsGrid
        If .Row >= .FixedRows Then
            Lab_Row = Trim(Str(.Row - .FixedRows + 1))
        End If
    End With
End Sub
Private Sub CzxsGrid_GotFocus()

    '网格得到焦点,如果当前选择行为非数据行
    '则调整当前焦点至有效数据行
    With CzxsGrid
        If .Row < .FixedRows And .Rows > .FixedRows Then
            Changelock = True
            .Select .FixedRows, .Col
            Changelock = False
        End If
        If .Col < Qslz Then     '
            Changelock = True
            .Select .Row, Qslz
            Changelock = False
        End If
    End With
    
End Sub

Private Sub CzxsGrid_KeyDown(KeyCode As Integer, Shift As Integer)
    '如果单据操作状态为浏览状态则不能显示录入载体
    If Trim(Lab_OperStatus.Caption) = "1" Then
        Exit Sub
    End If

    Select Case KeyCode
        Case vbKeyF2                   '按F2键参照
            Call xswbk
            Call Lrzdbz
    End Select
End Sub

Private Sub CzxsGrid_KeyPress(KeyAscii As Integer)
    '当某种条件成立时禁止文本框激活使单据处于录入状态
    If Not Fun_AllowInput Then
        Exit Sub
    End If
  
    With CzxsGrid
  
        '屏 蔽 回 车 键
        If KeyAscii = vbKeyReturn Then
            KeyAscii = 0
            Rowjsq = .Row
            Coljsq = .Col + 1
            If Coljsq > .Cols - 1 Then
                If Rowjsq < .Rows - 1 Then
                    Rowjsq = Rowjsq + 1
                End If
                Coljsq = Qslz
            End If
            Do While Rowjsq <= .Rows - 1
                If .ColHidden(Coljsq) Or (Not GridBoolean(Coljsq, 1)) Then
                    Coljsq = Coljsq + 1
                    If Coljsq > .Cols - 1 Then
                        Rowjsq = Rowjsq + 1
                        Coljsq = Qslz
                    End If
                Else
                    Exit Do
                End If
            Loop
          
            If Rowjsq <= .Rows - 1 Then
                .Select Rowjsq, Coljsq
            End If
       
            Exit Sub
       
        End If
     
        '接受用户录入
        Select Case KeyAscii
            Case 0 To 32             '用户输入KeyAscii为0-32的键 如空格
                '显示录入载体
                Call xswbk
            Case Else
                
                '防止非编辑字段SendKeys()出现死循环
                If Not GridBoolean(.Col, 1) Or .Row < .FixedRows Then
                    Exit Sub
                End If
                
                '如果此字段为列表框录入则调入相应列表框
                If GridBoolean(.Col, 3) Then
                   '列表框录入
                    Call xswbk
                Else
                    Ydtext.Text = ""
            
                    '录入限制
                    Call InputFieldLimit(Ydtext, GridInt(CzxsGrid.Col, 1), KeyAscii)
                    If KeyAscii = 0 Then
                        Exit Sub
                    End If
                    Call xswbk
                    Ydtext.Text = ""
                    Valilock = True
                    SendKeys Chr(KeyAscii), True
                    DoEvents
                    Valilock = False
                End If
        End Select
    End With
End Sub
Private Sub CzxsGrid_LeaveCell()
    If Changelock Then
        Exit Sub
    End If
    '记录刚刚离开网格单元的行列值
    Dqlkwgh = CzxsGrid.Row
    Dqlkwgl = CzxsGrid.Col
    '判断是否需要录入数据回写
    If Not (Ydtext.Visible Or YdCombo.Visible) Then
        Exit Sub
    End If
    Call Lrsjhx
End Sub
Private Sub CzxsGrid_LostFocus()
    '网格内部原因：网格单元内需要录入信息过程中，（程序控制）本单元内的文本框或下拉列表框显露并获得焦点时引发该事件发生；
    '网格外部原因：网格之外的控件获得焦点造成网格失去焦点，比如网格外的文本框。
    '用以屏蔽调用其它窗体时发生网格失去焦点事件
    If Changelock Then
        Exit Sub
    End If
    '在每个单元输入均合法，但整行输入有可能不合法，在文本框不可编辑状态，这时网格外的某控件获得焦点时，网格失去焦点，必须人为引发RowColChange事件
    '故意引发网格RowcolChange事件
    With CzxsGrid
        If Not (Ydtext.Visible Or YdCombo.Visible) Then
            .Select 0, 0
        End If
    End With
End Sub
Private Sub CzxsGrid_RowColChange()
    Valilock = True       '屏蔽文本框失去焦点进行有效性判断
    With CzxsGrid
        If Changelock Then
            Exit Sub
        End If
        If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
            Exit Sub
        End If
        If .Row <> Dqlkwgh Then     '若刚刚进入行《》刚刚离开行，进行行有效性判断
            If Not Sjhzyxxpd(Dqlkwgh) Then
                Exit Sub
            End If
        End If
    End With
    Call fhyxh      '返回有效行
    Call Xldql
End Sub
Private Sub CzxsGrid_AfterScroll(ByVal OldTopRow As Long, ByVal OldLeftCol As Long, ByVal NewTopRow As Long, ByVal NewLeftCol As Long)
    If Gdtlock Then
        Exit Sub
    End If
    With CzxsGrid
        If Ydtext.Visible Or YdCombo.Visible Then
            Gdtlock = True
            .TopRow = Dqtoprow
            .LeftCol = Dqleftcol
            Gdtlock = False
            Exit Sub
        End If
    End With
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)          '控制焦点转移
    jdzygs = 3
    Select Case KeyAscii
        Case vbKeyReturn
            If Kjjdzy(jdzygs) Then
                KeyAscii = 0
            End If
        Case 39           '屏蔽"'"
            KeyAscii = 0
    End Select
End Sub
Private Sub Form_Load()                                 '载入窗体
    
    '初始化各种锁值
    Changelock = False             '网格行列改变控制锁
    Gdtlock = False                '滚动条滚动控制
    Yxxpdlock = True               '字段有效性判断锁
    Hyxxpdlock = True              '行有效性判断锁
    Wbkbhlock = False              '文本框内容改变锁
    ShowBillLock = False           '显示否
    
    
    PrivateYear = Xtyear
    PrivateMm = Xtmm
    '定义可变部分变量
    ReportTitle = "成本费用分配"
    '调入打印页面设置窗体
    XtReportCode = "Cb_CostScatter"
    Load Dyymctbl
    '调入网格
    GridCode = "Cb_CostScatter"
    Call BzWgcsh(CzxsGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
    
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Pmbcsjhs = GridInf(3)
    Fzxwghs = GridInf(4)
    Sfblbzkd = GridInf(5)
    Shsfts = GridInf(6)
    Sfxshjwg = GridInf(7)
    Szzls = CzxsGrid.Cols - 1
    
    '会计期间
    Call Sub_FillPeriod(Combo_KJQJ, PrivateYear, PrivateMm)
    Combo_Sort.ListIndex = 0       '排序Combo
    '成本中心(对象)
    Call CshCostOCenter(Combo_Sort.ListIndex)
    
    '会计日历
    SqlStr = "Select Count(*) From gy_kjrlb where kjyear='" + Trim(Str(PrivateYear)) + "' And Period='" + CStr(PrivateMm) + "' " _
                    & "And CwzzJzbz='1'"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    If RecTemp.Fields(0) > 0 Then
        '设置工具条状态
        Call Sub_OperStatus("10")
    Else
        '设置工具条状态
        Call Sub_OperStatus("11")
    End If
    If Combo_Center.ListCount > 0 Then
        '显示数据(成本中心,成本对象)
        Call Sub_Query(Combo_Sort.ListIndex)
        ShowBillLock = True
    Else
        Call Sub_OperStatus("10")
    End If
    Lab_OperStatus.Caption = "1"
    '权限编码
    Str_RightEdit = "CB_CostScatter_Edit"
End Sub
Private Sub Sub_Query(List As Integer)                                     '查询内容填充网格
    Dim SqlStr As String
    Dim jsqte As Long
    
    '禁止网格刷新动作,为加快网格显示速度(Fixed)
    CzxsGrid.Redraw = False
    
    '查询连接串
    If List = 0 Then
        SqlStr = "Select A.ItemCode,B.ItemName,B.UnitName,B.PlanUnitPrice,A.ScatterQuantity,A.ScatterMoney, " _
                & "C.ObjectName , A.Objectcode, A.CenterCode " _
                & "From Cb_CostScatter A " _
                & "Left Outer Join (Select ItemCode,ItemName,PlanUnitPrice,UnitName From Cb_CostItem A " _
                & "Left Outer Join Gy_UnitSet B On A.MeasureUnit=B.UnitCode) B On A.ItemCode=B.ItemCode " _
                & "Left Outer Join Cb_CostObject C On A.ObjectCode=C.ObjectCode " _
                & "Where A.Year='" & PrivateYear & "' And A.Period='" & PrivateMm & "'  " _
                & "And A.ObjectCode='" & Combo_CenterCode(Combo_Center.ListIndex) & "'"
                
        CzxsGrid.ColHidden(Sydz("007", GridStr(), Szzls)) = True
    Else
        SqlStr = "Select A.ItemCode,B.ItemName,B.UnitName,B.PlanUnitPrice,A.ScatterQuantity,A.ScatterMoney, " _
                & "C.ObjectName , A.Objectcode, A.CenterCode " _
                & "From Cb_CostScatter A " _
                & "Left Outer Join (Select ItemCode,ItemName,PlanUnitPrice,UnitName From Cb_CostItem A " _
                & "Left Outer Join Gy_UnitSet B On A.MeasureUnit=B.UnitCode) B On A.ItemCode=B.ItemCode " _
                & "Left Outer Join Cb_CostObject C On A.ObjectCode=C.ObjectCode " _
                & "Where A.Year='" & PrivateYear & "' And A.Period='" & PrivateMm & "'  " _
                & "And A.CenterCode='" & Combo_CenterCode(Combo_Center.ListIndex) & "'"
                
        CzxsGrid.ColHidden(Sydz("007", GridStr(), Szzls)) = False
    End If
    Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    With Cxnrrec
        CzxsGrid.Rows = CzxsGrid.FixedRows
     
        If .EOF Then
            CzxsGrid.Redraw = True
            Exit Sub
        End If
     
        jsqte = CzxsGrid.FixedRows
        Do While Not .EOF
            CzxsGrid.AddItem ""
            '[>>显示
            CzxsGrid.TextMatrix(jsqte, 0) = "*"                                                                 '行标识
            CzxsGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("ItemCode") & "")          '项目编码
            CzxsGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("ItemName") & "")          '项目名称
            CzxsGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("UnitName") & "")          '计量单位
            CzxsGrid.TextMatrix(jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("PlanUnitPrice")) & ""     '计划单价
            CzxsGrid.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("ScatterQuantity") & "")   '分配数量