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

📄

📁 VB开发的ERP系统
💻
📖 第 1 页 / 共 2 页
字号:
'***********************************************

Option Explicit
Dim wgdmtemp As String
Dim Qslz As Long
Dim Sjhgd As Double
Dim Szzls As Integer
Dim wgszxx() As Variant              '整个网格设置信息
Dim wglxx()  As String               '网格列其他信息
Dim Wblrxz() As Integer              '文本框录入(事中)限制
Dim Wbbjsx() As Boolean              '(1-锁定某列使其不可编辑 2-是否提供帮助 3-是否列表框录入 4-字段不能为空控制)
Dim wgdmtemp_bb As String
Dim qslz_bb As Long
Dim Sjhgd_bb As Double
Dim Szzls_bb As Integer
Dim wgszxx_bb() As Variant              '整个网格设置信息
Dim wglxx_bb()  As String               '网格列其他信息
Dim Wblrxz_bb() As Integer              '文本框录入(事中)限制
Dim Wbbjsx_bb() As Boolean              '(1-锁定某列使其不可编辑 2-是否提供帮助 3-是否列表框录入 4-字段不能为空控制)
Dim song_tempflag As String

Private Sub Cxnrtcwg_bb()
    Dim Sqlstr As String
    Dim jsqte As Long
    Dim Cxnrrec As ADODB.Recordset
    '查询连接串
    vsFlexGrid2.Clear , flexClearData
    
    If vsFlexGrid1.Rows = Me.vsFlexGrid1.FixedRows Then
        Exit Sub
    End If
    
    Sqlstr = "select report_time,user_id,update_time,update_id from dzbb_bb where system_code='" _
    & Left(ls_xtbm, 2) & "' and  report_model_id in (select report_model_id from dzbb_right where bbuser_id='" _
    & Xtczybm & "' and system_code='" & Left(ls_xtbm, 2) & "') order by system_code,report_model_id,report_time DESC"
    
    Set Cxnrrec = Cw_DataEnvi.dataconnect.Execute(Sqlstr)
    With Cxnrrec
        If .EOF And .BOF Then
            vsFlexGrid2.Clear , flexClearData
            vsFlexGrid2.Rows = .RecordCount + vsFlexGrid2.FixedRows
            vsFlexGrid2.Redraw = True
            Exit Sub
        Else
            vsFlexGrid2.Redraw = False
            vsFlexGrid2.Clear , flexClearData
            vsFlexGrid2.Rows = .RecordCount + vsFlexGrid2.FixedRows
        End If
        jsqte = vsFlexGrid2.FixedRows
        Do While Not .EOF
            If jsqte >= vsFlexGrid2.Rows Then
                vsFlexGrid2.AddItem ""
            End If
            
            Call Jltcwg_bb(Cxnrrec, jsqte)
            
            vsFlexGrid2.RowHeight(jsqte) = Sjhgd
            .MoveNext
            jsqte = jsqte + 1
        Loop
    End With
    vsFlexGrid2.Redraw = True
    Set Cxnrrec = Nothing
End Sub

Private Sub Cxnrtcwg()
    Dim Sqlstr As String
    Dim jsqte As Long
    Dim Cxnrrec As ADODB.Recordset
    '查询连接串
    Sqlstr = "select report_model_id,report_model_name,user_id from dzbb_bbmb where system_code='" _
    & Left(ls_xtbm, 2) & "' and report_model_id in (select report_model_id from dzbb_right where bbuser_id='" _
    & Xtczybm & "' and editflag=1 and system_code='" & Left(ls_xtbm, 2) & "') order by system_code,report_model_id"
    Edit_Flag = True
    Set Cxnrrec = Cw_DataEnvi.dataconnect.Execute(Sqlstr)
    With Cxnrrec
        If .EOF And .BOF Then
            vsFlexGrid1.Clear , flexClearData
            vsFlexGrid1.Rows = .RecordCount + vsFlexGrid1.FixedRows
            vsFlexGrid1.Redraw = True
            Exit Sub
        Else
            vsFlexGrid1.Redraw = False
            vsFlexGrid1.Clear , flexClearData
            vsFlexGrid1.Rows = .RecordCount + vsFlexGrid1.FixedRows
        End If
        jsqte = vsFlexGrid1.FixedRows
        Do While Not .EOF
            If jsqte >= vsFlexGrid1.Rows Then
                vsFlexGrid1.AddItem ""
            End If
            
            Call Jltcwg(Cxnrrec, jsqte)
            
            vsFlexGrid1.RowHeight(jsqte) = Sjhgd
            .MoveNext
            jsqte = jsqte + 1
        Loop
    End With
    vsFlexGrid1.Redraw = True
    Set Cxnrrec = Nothing
End Sub

Private Sub Jltcwg(Jlbrec As ADODB.Recordset, Rowjsq As Long)                                     '记录内容填充网格
    '[以下为自定义部分
    With Jlbrec
        
        vsFlexGrid1.TextMatrix(Rowjsq, Sydz("001", wglxx(), Szzls)) = Trim(.Fields("report_model_id"))
        vsFlexGrid1.TextMatrix(Rowjsq, Sydz("002", wglxx(), Szzls)) = Trim(.Fields("report_model_name"))
        vsFlexGrid1.TextMatrix(Rowjsq, Sydz("003", wglxx(), Szzls)) = Trim(.Fields("user_id"))
        
    End With
    '以上为自定义部分]
End Sub

Private Sub Jltcwg_bb(Jlbrec As ADODB.Recordset, Rowjsq As Long)                                     '记录内容填充网格
    '[以下为自定义部分
    With Jlbrec
        vsFlexGrid2.TextMatrix(Rowjsq, Sydz("001", wglxx_bb(), Szzls_bb)) = Trim(.Fields("report_time"))
        vsFlexGrid2.TextMatrix(Rowjsq, Sydz("002", wglxx_bb(), Szzls_bb)) = Trim(.Fields("user_id"))
        vsFlexGrid2.TextMatrix(Rowjsq, Sydz("005", wglxx_bb(), Szzls_bb)) = ""
        vsFlexGrid2.TextMatrix(Rowjsq, Sydz("003", wglxx_bb(), Szzls_bb)) = Trim(.Fields("update_time"))
        vsFlexGrid2.TextMatrix(Rowjsq, Sydz("004", wglxx_bb(), Szzls_bb)) = Trim(.Fields("update_id"))
        
    End With
    '以上为自定义部分]
End Sub

Private Sub Command1_Click()
    Dim p As Boolean, i As Integer
    For i = 1 To vsFlexGrid2.Rows - 1
        If vsFlexGrid2.TextMatrix(i, 4) = "√" Then
            p = True
            Me.Hide
            Exit Sub
        End If
    Next i
    If p = False Then
        MsgBox "请选择报表!!!", vbInformation + vbOKOnly, "百利/ERP5.0-电子报表"
        
        Exit Sub
    End If
End Sub

Private Sub command2_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    wgdmtemp = "dzbb_bbmb"
    song_tempflag = "√"
    Call BzWgcsh(vsFlexGrid1, wgdmtemp, wgszxx(), Wbbjsx(), Wblrxz(), wglxx())
    
    Qslz = wgszxx(1)
    Sjhgd = wgszxx(2)
    Szzls = vsFlexGrid1.Cols - 1
    
    '调入网格2
    wgdmtemp_bb = "dzbb_bb"
    Call BzWgcsh(vsFlexGrid2, wgdmtemp_bb, wgszxx_bb(), Wbbjsx_bb(), Wblrxz_bb(), wglxx_bb())
    vsFlexGrid2.SelectionMode = flexSelectionFree
    vsFlexGrid2.FocusRect = flexFocusHeavy
    vsFlexGrid2.ForeColorSel = &H80000008
    vsFlexGrid2.BackColorSel = &H80000005
    vsFlexGrid2.ScrollBars = flexScrollBarVertical
    
    qslz_bb = wgszxx_bb(1)
    Sjhgd_bb = wgszxx_bb(2)
    Szzls_bb = vsFlexGrid2.Cols - 1
    
    Call Cxnrtcwg
    Call vsFlexGrid1_SelChange
End Sub

Private Sub Form_Unload(Cancel As Integer)
    song_temp = 0
End Sub

Private Sub vsFlexGrid1_SelChange()
    Dim Sqlstr As String
    Dim jsqte As Long
    Dim Cxnrrec As ADODB.Recordset
    '查询连接串
    vsFlexGrid2.Clear , flexClearData
    vsFlexGrid2.Rows = 1
    If vsFlexGrid1.Rows <= 1 Then
        Exit Sub
    End If
    Label2.Caption = Trim(vsFlexGrid1.TextMatrix(vsFlexGrid1.Row, 0)) & "-" & Trim(vsFlexGrid1.TextMatrix(vsFlexGrid1.Row, 1))
    
    Sqlstr = "select report_time,user_id,update_time,update_id  from dzbb_bb where system_code='" _
    & Left(ls_xtbm, 2) & "' and  report_model_id='" _
    & Trim(vsFlexGrid1.TextMatrix(vsFlexGrid1.Row, Sydz("001", wglxx(), Szzls))) _
    & "' order by system_code,report_model_id,report_time"
    
    Set Cxnrrec = Cw_DataEnvi.dataconnect.Execute(Sqlstr)
    With Cxnrrec
        If .EOF And .BOF Then
            Exit Sub
        Else
            vsFlexGrid2.Redraw = False
            vsFlexGrid2.Rows = .RecordCount + vsFlexGrid2.FixedRows
        End If
        jsqte = vsFlexGrid2.FixedRows
        Do While Not .EOF
            If jsqte >= vsFlexGrid2.Rows Then
                vsFlexGrid2.AddItem ""
            End If
            
            Call Jltcwg_bb(Cxnrrec, jsqte)
            
            vsFlexGrid2.RowHeight(jsqte) = Sjhgd
            .MoveNext
            jsqte = jsqte + 1
        Loop
    End With
    vsFlexGrid2.Redraw = True
    Set Cxnrrec = Nothing
End Sub

Private Sub vsFlexGrid2_Click()
    Dim k
    
    If vsFlexGrid2.Row = 0 Then Exit Sub
    With vsFlexGrid2
        
        If .TextMatrix(.Row, 4) = song_tempflag Then '取消权限
            .TextMatrix(.Row, 4) = ""
            For k = 0 To .Cols - 1
                .Col = k
                .CellBackColor = RGB(0, 0, 0)
            Next k
        Else '增加权限
            .TextMatrix(.Row, 4) = song_tempflag
            For k = 0 To .Cols - 1
                .Col = k
                .CellBackColor = &HC0FFC0
            Next k
            
        End If
    End With
    
End Sub

Private Sub vsFlexGrid2_DblClick()
    'Command1_Click
End Sub

⌨️ 快捷键说明

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