【VB开源代码栏目提醒】：网学会员在VB开源代码频道为大家收集整理了frmGET.frm提供大家参考，希望对大家有所帮助!

    VERSION 5.00
    Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "Msflxgrd.ocx"
    Begin VB.Form frmGET 
       Caption         =   "应收信息列表"
       ClientHeight    =   4995
       ClientLeft      =   45
       ClientTop       =   345
       ClientWidth     =   7770
       LinkTopic       =   "Form1"
       MDIChild        =   -1  'True
       ScaleHeight     =   4995
       ScaleWidth      =   7770
       WindowState     =   2  'Maximized
       Begin MSFlexGridLib.MSFlexGrid msgList 
          Height          =   3132
          Left            =   120
          TabIndex        =   1
          Top             =   600
          Width           =   7452
          _ExtentX        =   13150
          _ExtentY        =   5530
          _Version        =   393216
          Cols            =   4
          FixedCols       =   3
          AllowUserResizing=   1
       End
       Begin VB.Label lblTitle 
          Caption         =   "应  收  信  息  列  表"
          BeginProperty Font 
             Name            =   "宋体"
             Size            =   12
             Charset         =   134
             Weight          =   700
             Underline       =   0   'False
             Italic          =   0   'False
             Strikethrough   =   0   'False
          EndProperty
          ForeColor       =   &H8000000D&
          Height          =   252
          Left            =   1440
          TabIndex        =   0
          Top             =   240
          Width           =   3012
       End
    End
    Attribute VB_Name = "frmGET"
    Attribute VB_GlobalNameSpace = False
    Attribute VB_Creatable = False
    Attribute VB_PredeclaredId = True
    Attribute VB_Exposed = False
    Option Explicit
    Public txtSQL As String
    Dim mrc As ADODB.Recordset
    '用户的读写权限标识
    Dim mintRW As Integer
    '状态条中显示的时间信息
    Public msBarText As String
    Public reportSQL As String
    Public Sub GetMoney()
        Dim intCount As Integer
        
        If msgList.Rows > 1 Then
            intCount = msgList.Row
            If intCount > 0 Then
               frmGET1.txtSQL = "select outh.outh_no,outh.out_date,dm_ywy.mc,outh.khdm,dm_kh.mc,dm_kh.ywman,dm_kh.lbdm,dm_wz.mc,outh.qihao,outh.sl,outh.out_danj,outh.o_zke from outh inner join dm_ywy on outh.ywman = dm_ywy.dm inner join dm_kh on outh.khdm = dm_kh.dm inner join dm_wz on outh.wzdm = dm_wz.dm  where outh_no ='" & Trim(msgList.TextMatrix(intCount, 1)) & "'"
               frmGET1.Show 1
            Else
                MsgBox "警告", vbOKOnly + vbExclamation, "请首先选择收款登记的纪录！"
            End If
        End If
    End Sub
    
    
    Private Sub Form_Activate()
        '设置读写权限
        SetWorkRW mintRW
        With fMainForm
            .mnuWorkGet.Visible = True
            .tbToolBar.Buttons.Item("Get").Enabled = True
                .mnuWorkAdd.Visible = False
                .mnuWorkDelete.Visible = False
                .mnuWorkEdit.Visible = False
                .tbToolBar.Buttons.Item("Add").Enabled = False
                .tbToolBar.Buttons.Item("Delete").Enabled = False
                .tbToolBar.Buttons.Item("Edit").Enabled = False
                .mnuWork.Visible = False
                '.mnuSysClose.Enabled = True
                .tbToolBar.Buttons.Item("Find").Enabled = False
               
                .tbToolBar.Buttons.Item("Refresh").Enabled = False
            
        End With
    End Sub
    
    Private Sub Form_Load()
        '用户操作权限
        Dim sPermission As String
        Dim recTemp As Recordset
        Dim sSQL As String
        Dim sByte As String
        Dim MsgText As String
        
      On Error GoTo myErr
        '设置操作的表名称
        'msTableName = "ampaytune"
        'msRptName = "paytune.rpt"
        'msOrderBy = " order by tzdate,tzid"
        'sOrder0 = "+ {tzdate}"
        'sOrder1 = "+ {tzid}"
        'msSelect = "select * from "
        
        '置mintRW初值
        mintRW = 0
        sSQL = "select rw from permission where module=14 and id='" & sUserName & " '"
        Set recTemp = ExecuteSQL(sSQL, MsgText)
        If recTemp.EOF = False Then
            mintRW = CInt(recTemp!rw)
        Else
            mintRW = ERRORMODE
            SetMdiEnv
            MsgBox "您的帐号权限有错误！", vbOKOnly + vbCritical, "错误"
            Exit Sub
        End If
        
    
        
        '设置msSql
            'msSql = msSelect & msTableName & " where tzdate>='" & Format(DateAdd("m", -1, Now), "yyyy-mm-dd") & "' and tzdate<='" & Format(Now, "yyyy-mm-dd") & "'" & msOrderBy
            
        '显示数据
        msBarText = "当前数据时间范围：" & Format(DateAdd("m", -1, Now), "yyyy-mm-dd") & "至" & Format(Now, "yyyy-mm-dd")
        ShowTitle
        ShowData
        
        Set recTemp = Nothing
        Exit Sub
        
    myErr:
        ShowError
    
    
    
    
    
    
    End Sub
    
    
    Private Sub Form_Resize()
        If Me.WindowState <> vbMinimized And fMainForm.WindowState <> vbMinimized Then
            '边界处理
            If Me.ScaleHeight < 10 * lblTitle.Height Then
                
                Exit Sub
            End If
            If Me.ScaleWidth < lblTitle.Width + lblTitle.Width / 2 Then
                
                Exit Sub
            End If
            '控制控件的位置
                    
            lblTitle.Top = lblTitle.Height
            lblTitle.Left = (Me.Width - lblTitle.Width) / 2
            
            msgList.Top = lblTitle.Top + lblTitle.Height + lblTitle.Height / 2
            msgList.Width = Me.ScaleWidth - 200
            msgList.Left = Me.ScaleLeft + 100
            msgList.Height = Me.ScaleHeight - msgList.Top
            
        End If
    End Sub
    
    
    
    Public Sub FormClose()
        Unload Me
    End Sub
    Private Sub ShowData()
        
        Dim j As Integer
        Dim i As Integer
        Dim MsgText As String
    
      
        Set mrc = ExecuteSQL(txtSQL, MsgText)
            With msgList
            .Rows = 1
            
            Do While Not mrc.EOF
                .Rows = .Rows + 1
                For i = 1 To mrc.Fields.Count
                    If Not IsNull(Trim(mrc.Fields(i - 1))) Then
                    Select Case mrc.Fields(i - 1).Type
                        Case adDBDate
                            .TextMatrix(.Rows - 1, i) = Format(mrc.Fields(i - 1) & "", "yyyy-mm-dd")
                        Case Else
                            .TextMatrix(.Rows - 1, i) = mrc.Fields(i - 1) & ""
                    End Select
                    End If
                Next i
                mrc.MoveNext
            Loop
            
              
        End With
        mrc.Close
        
        
    End Sub
    Private Sub ShowTitle()
        Dim i As Integer
        
        With msgList