⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄

📁 VB开发的ERP系统
💻
📖 第 1 页 / 共 5 页
字号:
                End If
            End If
        End If
    
        If Hyxxpdlock Then
            Sjhzyxxpd = True
            Exit Function
        End If
  
        '以下为自定义部分[
   
            '1.放置行有效性判断程序
           
            '首先进行为空判断(固定不变)
            For Jsqte = Qslz To .Cols - 1
                If (GridInt(Jsqte, 5) = 1 And Len(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0) Or (GridInt(Jsqte, 5) = 2 And Val(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0) Then
                    Tsxx = GridStr(Jsqte, 2)
                    Lrywlz = Jsqte
                    GoTo Lrcwcl
                    Exit For
                End If
            Next Jsqte
           
            '自定义判断(补丁)
           
            If Val(.TextMatrix(Yxxpdh, Sydz("007", GridStr(), Szzls))) <= 0 Then
                Lrywlz = Sydz("007", GridStr(), Szzls)
                Tsxx = "平均单价必须大于零!"
                GoTo Lrcwcl
            End If
            
            '2.放置行处理程序
                     
    
   '以上为自定义部分]
 
    End With
 
    Sjhzyxxpd = True
    Hyxxpdlock = True
    Exit Function
 
Lrcwcl:      '录入错误处理

    With WglrGrid
        Call Xtxxts(Tsxx, 0, 1)
        Changelock = True
        .Select Yxxpdh, Lrywlz
        Changelock = False
        Call xswbk
        Sjhzyxxpd = False
        Exit Function
    End With
    
End Function

Private Function Sub_SaveBill() As Boolean                   '保 存 单 据
 
    Dim Rowjsq As Long           '网格行计数器
    Dim Coljsq As Long           '网格列计数器
    Dim Int_RowCount As Integer  '有效数据行计数器
    Dim Lrywlz As Long           '录入有误列值
    Dim FindRow As Long
    Dim SqlStr As String
  
  '[判断用户所选会计期间是否有效(非结帐月份)
  '下面将对所有有效数据行进行有效性判断
  
  
    Int_RowCount = 0
  
    With WglrGrid
     
        For Rowjsq = .FixedRows To .Rows - 1
     
            '带*号者为有效数据行
            If .TextMatrix(Rowjsq, 0) <> "*" Then
                Exit For
            Else
                Int_RowCount = Int_RowCount + 1
            End If
         
            '1.首先进行为空或为零判断(固定不变)
            For Coljsq = Qslz To .Cols - 1
                If (GridInt(Coljsq, 5) = 1 And Len(Trim(.TextMatrix(Rowjsq, Coljsq))) = 0) Or (GridInt(Coljsq, 5) = 2 And Val(Trim(.TextMatrix(Rowjsq, Coljsq))) = 0) Then
                    Tsxx = GridStr(Coljsq, 2)
                    Lrywlz = Coljsq
                    GoTo Lrcwcl
                    Exit For
                End If
            Next Coljsq
           
            '2.[自定义判断(补丁)
            If Val(WglrGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls))) <= 0 Then
                Tsxx = "平均单价不能小于等于零!"
                Lrywlz = Sydz("007", GridStr(), Szzls)
                GoTo Lrcwcl
                Exit For
            End If
             
        Next Rowjsq
     
    End With  '网格
   
    '如果以上有效性检查均顺利通过,则执行存盘动作
   
    On Error GoTo Swcwcl
    
    Cw_DataEnvi.DataConnect.BeginTrans
       
    '保存单价
    For Jsqte = WglrGrid.FixedRows To WglrGrid.Rows - 1
        SqlStr = "UPDATE Chhs_Mate SET EndPrice='" & Val(WglrGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls))) & "'" & _
                 "WHERE MateId='" & Val(WglrGrid.TextMatrix(Jsqte, 1)) & "' "
        Cw_DataEnvi.DataConnect.Execute (SqlStr)
    Next Jsqte

    Cw_DataEnvi.DataConnect.CommitTrans

    Save_Flag = True
    Edit_Flag = True
    
    Sub_SaveBill = True
    Tsxx = "保存完毕!"
    Call Xtxxts(Tsxx, 0, 4)
  
    Exit Function
  
Swcwcl:

    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "保存失败,程序自动恢复保存前状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Exit Function

Lrcwcl:        '录入错误处理
    With WglrGrid
        Call Xtxxts("(第 " + Trim(Str(Int_RowCount)) + " 条分录)-" + Tsxx, 0, 1)
        Changelock = True
        .Select Rowjsq, Lrywlz
        WglrGrid.SetFocus
        Changelock = False
        Exit Function
    End With

End Function


'===================以 下 程 序 为 通 用 部 分 ,一 般 不 需 更 改======================='
Private Sub Sub_AdjustGrid()
    
    '调 整 网 格
    With WglrGrid
        '加 1 保持一行录入行
        If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
            .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
            For Jsqte = .FixedRows To .Rows - 1
                .RowHeight(Jsqte) = Sjhgd
            Next Jsqte
        End If
    End With
    
End Sub
Private Sub Lrzdbz()                                                      '录入字段帮助
   
    If Not Ydcommand.Visible Then
        Exit Sub
    End If
    
    Valilock = True
    With WglrGrid
        Changelock = True        '调入另外窗体必须加锁
        Call Drbmhelp(GridInt(.Col, 6), GridStr(.Col, 3), Trim(Ydtext.Text))
        Changelock = False
        
        If Len(Xtfhcs) <> 0 Then
            If GridInt(.Col, 7) = 0 Then
                Ydtext.Text = Xtfhcs
            Else
                Ydtext.Text = Xtfhcsfz
            End If
        End If
        Valilock = False
        Ydtext.SetFocus
    End With
    
End Sub

Private Sub Form_Resize()                                                '窗体大小发生变化时,重新显示文本框
    Call Cxxswbk
End Sub

Private Function Fun_Drfrmyxxpd() As Boolean                             '调入其它窗体或功能产生的有效性判断(包括数据回写)
  
    Fun_Drfrmyxxpd = True
  
    With WglrGrid
   
        '如果当前网格处于编辑状态,则先进行数据回写再进行有效性判断
        If Ydtext.Visible Or YdCombo.Visible Then
            Call Lrsjhx
            If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
                Fun_Drfrmyxxpd = False
                Exit Function
            End If
        End If
   
        '进行行有效性判断
        If Not Sjhzyxxpd(.Row) Then
            Fun_Drfrmyxxpd = False
            Exit Function
        End If
   
    End With
    
End Function

Private Sub WglrGrid_EnterCell()                                    '显示当前数据行相关信息
   
    With WglrGrid
    
        If .Row >= .FixedRows Then
            Lab_Row = Trim(Str(.Row - .FixedRows + 1))
            Lbl_Label3 = Lab_Row
        End If
        
    End With
   
End Sub

Private Sub WglrGrid_GotFocus()                                     '网格得到焦点
  
    '网格得到焦点,如果当前选择行为非数据行
    '则调整当前焦点至有效数据行
   
    With WglrGrid
      
        If .Rows = .FixedRows Then Exit Sub
     
        If .Row < .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 WglrGrid_LostFocus()                                    '录入网格失去焦点

    '用以屏蔽调用其它窗体时发生网格失去焦点事件
    If Changelock Then
        Exit Sub
    End If
    
    '引发网格RowcolChange事件
    With WglrGrid
        If Not (Ydtext.Visible Or YdCombo.Visible) Then
            .Select 0, 0
        End If
    End With
  
End Sub

Private Sub WglrGrid_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 WglrGrid
        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 WglrGrid_LeaveCell()                                    '离开单元格
    
    If Changelock Then
        Exit Sub
    End If
  
    '记录刚刚离开网格单元的行列值
    Dqlkwgh = WglrGrid.Row
    Dqlkwgl = WglrGrid.Col
  
    '判断是否需要录入数据回写
    If Not (Ydtext.Visible Or YdCombo.Visible) Then
        Exit Sub
    End If
    
    Call Lrsjhx
    
End Sub

Private Sub WglrGrid_RowColChange()                                '网格录入行列发生变化时,进行有效性判断
   
    Valilock = True       '屏蔽文本框失去焦点进行有效性判断
    With WglrGrid
        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 WglrGrid_DblClick()          '鼠标双击网格显示文本框
  
    With WglrGrid
        Call xswbk
    End With
    
End Sub

Private Sub Ycwbk()                      '隐藏文本框,帮助按钮,列表组合框

    Ydtext.Visible = False
    YdCombo.Visible = False
    
End Sub

Private Sub YdCombo_KeyDown(KeyCode As Integer, Shift As Integer)        '列表框移动
  
    With WglrGrid
        Select Case KeyCode
            Case vbKeyEscape                'ESC 键放弃录入
                Valilock = True
                .SetFocus
                Call Ycwbk
                Valilock = False
            Case vbKeyReturn                '回 车 键 =13
                KeyCode = 0
                .SetFocus
                Call Lrsjhx
                Rowjsq = .Row
                Coljsq = .Col + 1
                If Coljsq > .Cols - 1 Then
                    If Rowjsq < .Rows - 1 Then
                        Rowjsq = Rowjsq + 1
                    End If

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -