VB开发的ERP系统

        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_Inventory"
    Load Dyymctbl
    
    '树结构
    Call cshtree
    
    '调入网格
    GridCode = "Cb_Inventory"
    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)     '会计期间
    TreeNots_Code = ""                                          '显示记录
    Call ShowCostInventory
    
    Lab_OperStatus.Caption = "1"
    '判断是否有数据
    SqlStr = "Select count(*) From Cb_CostStructure Where CheckFlag='1'"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    If RecTemp.Fields(0) <= 0 Then
        Call Sub_OperStatus("10")
    Else
        ShowBillLock = True
    End If
    '权限编号
    Str_RightEdit = "CB_Inventory_Edit"
End Sub
Private Sub Sub_Query(Code As String, Index As Integer)                                   '查询内容填充网格
    Dim SqlStr As String
    Dim jsqte As Long
    
    '禁止网格刷新动作,为加快网格显示速度(Fixed)
    CzxsGrid.Redraw = False
    
    '查询连接串
    If Index = 0 Then
        SqlStr = "Select A.ItemCode,C.ItemName,C.UnitName,C.PlanUnitPrice,B.InvQuantity,B.InvValue,A.Objectcode,A.CenterCode,D.CenterName From " _
                    & "Cb_CostStructure A " _
                    & "Left Outer Join Cb_Inventory B On " _
                    & "A.ObjectCode=B.Objectcode And A.ItemCode=B.ItemCode And B.Year='" + CStr(PrivateYear) + "' and B.Period='" + CStr(PrivateMm) + "' " _
                    & "Left Outer Join (Select A.ItemCode,A.ItemName,A.PlanUnitPrice,B.UnitName From Cb_CostItem A  " _
                    & "Left Outer Join Gy_UnitSet B On A.MeasureUnit=B.UnitCode ) C On A.ItemCode=C.ItemCode " _
                    & "Left Outer Join Cb_CostCenter D On A.CenterCode=D.CenterCode " _
                    & "Where A.ObjectCode='" & Code & "' And A.CheckFlag='1'"
    Else
        SqlStr = "Select A.ItemCode,B.ItemName,B.UnitName,A.PlanUnitCost as PlanUnitPrice,A.InvQuantity,A.InvValue,A.ObjectCode,A.CenterCode,C.CenterName From Cb_Inventory A " _
                    & "Left Outer Join (Select ItemCode,ItemName,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_CostCenter C On A.CenterCode=C.CenterCode " _
                    & "Where A.ObjectCode='" & Code & "' And A.Year='" + CStr(PrivateYear) + "' And A.Period='" + CStr(PrivateMm) + "'"
    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("CenterName") & "")    '成本中心
            CzxsGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("ItemCode") & "")      '项目编码
            CzxsGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("ItemName") & "")      '项目名称
            CzxsGrid.TextMatrix(jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("UnitName") & "")      '计量单位
            CzxsGrid.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("PlanUnitPrice")) & "" '计划单价
            CzxsGrid.TextMatrix(jsqte, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("InvQuantity") & "")   '盘存数量
            CzxsGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("InvValue") & "")      '盘存金额
            CzxsGrid.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)) = Trim(.Fields("CenterCode") & "")    '中心编码
            CzxsGrid.TextMatrix(jsqte, Sydz("009", GridStr(), Szzls)) = Trim(.Fields("Objectcode") & "")    '对象编码
            '<<]
            CzxsGrid.RowHeight(jsqte) = Sjhgd
            .MoveNext
            jsqte = jsqte + 1
        Loop
    End With
    
    '将网格刷新解禁(Fixed)
    CzxsGrid.Redraw = True

End Sub
Private Sub Form_Resize()                                   '调整窗体
    On Error Resume Next
    With Tree_List
        .Width = Me.Width / 4 + Me.Width / 40
        .Height = Me.Height - .Top - 400
    End With
    With CzxsGrid
        .Left = Tree_List.Left + Tree_List.Width + 30
        .Width = Me.Width - (Me.Width / 4 + Me.Width / 40) - 170
        .Height = Me.Height - .Top - 400
    End With
    With Pic_Title
        .Width = Me.Width - 140
    End With
    GsToolbar.Left = Me.Width - GsToolbar.Width - 140
    Call Cxxswbk
End Sub
Private Sub Form_Unload(Cancel As Integer)                   '窗体卸载
    Set Cxnrrec = Nothing
    Unload Dyymctbl
End Sub
Private Function Sub_SaveBill() As Boolean                   '保存数据
    Dim Recfind As New ADODB.Recordset     '有效性判断动态集
    Dim Rowjsq As Long           '网格行计数器
    Dim Coljsq As Long           '网格列计数器
    Dim Int_RowCount As Integer  '有效数据行计数器
    Dim Lrywlz As Long           '录入有误列值
    '下面将对所有有效数据行进行有效性判断
    Int_RowCount = 0
    With CzxsGrid
        For Rowjsq = .FixedRows To .Rows - 1
            '带*号者为有效数据行
            If .TextMatrix(Rowjsq, 0) <> "*" Then
                Exit Function
            Else
                Int_RowCount = Int_RowCount + 1
            End If
               
            '2.[自定义判断(补丁)
            '首先进行为空判断(固定不变)
            For jsqte = Qslz To .Cols - 1
                If (GridInt(jsqte, 5) = 1 And Len(Trim(.TextMatrix(Rowjsq, jsqte))) = 0) Or (GridInt(jsqte, 5) = 2 And Val(Trim(.TextMatrix(Rowjsq, jsqte))) = 0) Then
                    Tsxx = GridStr(jsqte, 2)
                    Lrywlz = jsqte
                    GoTo Lrcwcl
                    Exit For
                End If
            Next jsqte
        Next
        If Int_RowCount = 0 Then
            Tsxx = "有效行数为零,不能存盘!"
            Call Xtxxts(Tsxx, 0, 1)
            Exit Function
        End If