VB开发的ERP系统

            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_ObjectComplete"
    Load Dyymctbl
    '调入网格
    GridCode = "Cb_ObjectComplete"
    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)
    '成本中心
    Call CshCostCenter
    If Combo_Center.ListCount > 0 Then
        '显示数据
        Call ShowObjectComplete
        ShowBillLock = True
    Else
        Call Sub_OperStatus("10")
    End If
    
    Lab_OperStatus.Caption = "1"
    
    '编辑权限
    Str_RightEdit = "CB_ObjectComplete_Edit"
    '审核权限
    Str_RightCheck = "CB_ObjectComplete_Check"
End Sub
Private Sub Sub_Query(Index As Integer)                                     '查询内容填充网格
    Dim SqlStr As String
    Dim jsqte As Long
    
    '禁止网格刷新动作,为加快网格显示速度(Fixed)
    CzxsGrid.Redraw = False
    
    '查询连接串
    If Index = 0 Then
        SqlStr = "Select A.Objectcode,A.ObjectName,B.UnitName,A.PlanQuantity,A.PlanCost,C.Quantity,C.Auditing " _
                & "From Cb_CostObject A " _
                & "Left Outer Join Gy_UnitSet B On A.MeasureUnitCode=B.UnitCode " _
                & "Left Outer Join Cb_ObjectComplete C On A.ObjectCode=C.ObjectCode And C.Year='" & PrivateYear & "' And C.Period='" & PrivateMm & "' " _
                & "Where A.CenterCode='" & Combo_CenterCode(Combo_Center.ListIndex) & "'"
    Else
        SqlStr = "Select * From (Select A.Objectcode,B.ObjectName,B.UnitName,A.PlanQuantity,A.PlanCost,A.Quantity,A.Auditing, " _
                & "A.Year,A.Period,B.CenterCode From Cb_ObjectComplete A " _
                & "Left Outer Join (Select ObjectCode,ObjectName,UnitName,CenterCode From Cb_CostObject A " _
                & "Left Outer Join Gy_UnitSet B On A.MeasureUnitCode=B.UnitCode) B On A.ObjectCode=B.ObjectCode) A " _
                & "Where A.CenterCode='" & Combo_CenterCode(Combo_Center.ListIndex) & "' And A.Year='" & PrivateYear & "' And A.Period='" & 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("Objectcode") & "")    '对象编码
            CzxsGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("ObjectName") & "")    '对象名称
            CzxsGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("UnitName") & "")      '计量单位
            CzxsGrid.TextMatrix(jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("PlanQuantity")) & ""  '定额数量
            CzxsGrid.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("PlanCost") & "")      '计划成本
            CzxsGrid.TextMatrix(jsqte, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("Quantity") & "")      '数量
            CzxsGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("Auditing") & "")      '审核
            '<<]
            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 CzxsGrid
        .Width = Me.Width - 160
        .Height = Me.Height - .Top - 400
    End With
    With Pic_Title
        .Width = Me.Width - 160
    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
    End With  '网格
    
    '如果以上有效性检查均顺利通过,则执行存盘动作
    
    On Error GoTo Swcwcl
    Cw_DataEnvi.DataConnect.BeginTrans
    For Rowjsq = CzxsGrid.FixedRows To CzxsGrid.Rows - 1
        SqlStr = "Delete From Cb_ObjectComplete Where Year='" & PrivateYear & "' And Period='" & PrivateMm & "' And ObjectCode='" + Trim(CzxsGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls))) + "'"
        Cw_DataEnvi.DataConnect.Execute (SqlStr)