📄 商户查询.frm

📁 一间公司的管理系统的源码
💻 FRM
📖 第 1 页 / 共 2 页
字号:
上一页 12
      Height          =   255
      Left            =   360
      TabIndex        =   11
      Top             =   1725
      Width           =   1635
   End
   Begin VB.Line Line2 
      BorderColor     =   &H80000005&
      X1              =   0
      X2              =   10200
      Y1              =   2175
      Y2              =   2175
   End
   Begin VB.Line Line1 
      BorderColor     =   &H80000010&
      X1              =   0
      X2              =   10200
      Y1              =   2160
      Y2              =   2160
   End
   Begin VB.Label lblHelp1 
      Caption         =   "支持模糊查询"
      ForeColor       =   &H00FF0000&
      Height          =   255
      Left            =   1560
      TabIndex        =   7
      Top             =   640
      Width           =   1095
   End
End
Attribute VB_Name = "shanghuchaxun"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim HintMsg As String 'lblHInt标签的提示信息

Private Sub cmdSearch_Click()

If Trim(txtKeywords.Text) = "" Then
    MsgBox "请输入要查找的内容！", vbOKOnly + vbExclamation, App.Title
    txtKeywords.Text = ""
    txtKeywords.SetFocus
    Exit Sub
End If

If optIf(0).Value = True Then

    sql = "select * from [商户档案] where [法人代表] like '%" & txtKeywords.Text & "%'"
    ErrMsg = "没有找到法人代表为【" & txtKeywords.Text & "】的商户档案！"

ElseIf optIf(1).Value = True Then

    sql = "select * from [商户档案] where [公司名称] like '%" & txtKeywords.Text & "%'"
    ErrMsg = "没有找到公司名称为【" & txtKeywords.Text & "】的商户档案！"

ElseIf optIf(2).Value = True Then

    If IsDate(txtKeywords) = False Then
        MsgBox "日期格式不正确！" & vbCr & vbCr & "正确的日期格式为：2004-6-12"
        txtKeywords.SetFocus
        txtKeywords.SelStart = 0
        txtKeywords.SelLength = Len(txtKeywords.Text)
        Exit Sub
    End If
    
    If optFrontDay.Value = True Then
        sql = "select * from [商户档案] where [到期日期]<#" & txtKeywords.Text & "#"
        ErrMsg = "没有找到到期日期为【" & txtKeywords.Text & "】的商户档案！"
    ElseIf optBehindDay.Value = True Then
        sql = "select * from [商户档案] where [到期日期]>#" & txtKeywords.Text & "#"
        ErrMsg = "没有找到到期日期为【" & txtKeywords.Text & "】的商户档案！"
    Else
        sql = "select * from [商户档案] where [到期日期]=#" & txtKeywords.Text & "#"
        ErrMsg = "没有找到到期日期为【" & txtKeywords.Text & "】的商户档案！"
    End If

ElseIf optIf(3).Value = True Then

    If IsNumeric(txtKeywords.Text) = False Then
        MsgBox "合同编号只能是数字！"
        txtKeywords.SetFocus
        txtKeywords.SelStart = 0
        txtKeywords.SelLength = Len(txtKeywords.Text)
        Exit Sub
    End If
    sql = "select * from [商户档案] where [合同编号] = '" & txtKeywords.Text & "'"
    ErrMsg = "没有找到合同编号为【" & txtKeywords.Text & "】的商户档案！"

ElseIf optIf(4).Value = True Then

    sql = "select * from [商户档案] where [所在区位] like '%" & txtKeywords.Text & "%'"
    ErrMsg = "没有找到所在区位为【" & txtKeywords.Text & "】的商户档案！"
    
ElseIf optIf(5).Value = True Then

    If IsNumeric(txtKeywords.Text) = False Then
        MsgBox "欠费金额只能是数字！"
        txtKeywords.SetFocus
        txtKeywords.SelStart = 0
        txtKeywords.SelLength = Len(txtKeywords.Text)
        Exit Sub
    End If
    
    If OptSmall.Value = True Then
        sql = "select * from [商户档案] where -[欠费金额]< " & txtKeywords.Text
        ErrMsg = "没有找到欠费金额小于【" & txtKeywords.Text & "】的商户档案！"
    ElseIf OptBig.Value = True Then
        sql = "select * from [商户档案] where -[欠费金额]> " & txtKeywords.Text
        ErrMsg = "没有找到欠费金额大于【" & txtKeywords.Text & "】的商户档案！"
    Else
        sql = "select * from [商户档案] where -[欠费金额]= " & txtKeywords.Text
        ErrMsg = "没有找到欠费金额等于【" & txtKeywords.Text & "】的商户档案！"
    End If

ElseIf optIf(6).Value = True Then

    If IsNumeric(txtKeywords.Text) = False Then
        MsgBox "剩余天数只能是数字！"
        txtKeywords.SetFocus
        txtKeywords.SelStart = 0
        txtKeywords.SelLength = Len(txtKeywords.Text)
        Exit Sub
    End If

    If OptLess.Value = True Then
        sql = "select * from [商户档案] where [到期日期]-#" & Date & "#<" & txtKeywords.Text
        ErrMsg = "没有找到剩余天数少于【" & txtKeywords.Text & "】的商户档案！"
    ElseIf OptMore.Value = True Then
        sql = "select * from [商户档案] where [到期日期]-#" & Date & "#>" & txtKeywords.Text
        ErrMsg = "没有找到剩余天数多于【" & txtKeywords.Text & "】的商户档案！"
    Else
        sql = "select * from [商户档案] where [到期日期]-#" & Date & "#=" & txtKeywords.Text
        ErrMsg = "没有找到剩余天数等于【" & txtKeywords.Text & "】的商户档案！"
    End If
End If

rs.Open sql, conn, 1, 1


If rs.EOF Then
    MsgBox ErrMsg, vbInformation + vbOKOnly, App.Title
    ErrMsg = ""
    txtKeywords.SetFocus
    txtKeywords.SelStart = 0
    txtKeywords.SelLength = Len(txtKeywords.Text)
    rs.Close
    Set rs = Nothing
    Exit Sub
Else
    HintMsg = "符合条件的商户" '改变lblHint标签的提示为此信息
    '调用ShowInfo过程，显示符合条件记录
    Call ShowInfo
End If
End Sub

Private Sub Form_Load()

Call CheckLogin(Me)
Call SetCenter(Me)
Call OpenDB

'今日到期商户
sql = "select * from [商户档案] where [到期日期]=#" & Date & "#"
rs.Open sql, conn, 1, 1
If rs.EOF Then
    rs.Close
    Set rs = Nothing
    lblHint = "今天到期的商户"
    lblCount = "共计：0 人次"
Else
    MsgBox "今天有到期的商户！" & vbCr & vbCr & "请抓紧时间催交房费或退房！", vbOKOnly + vbInformation, App.Title
    Call ShowInfo
End If

'设置网格高度为300 Twip
SearchList.RowHeightMin = 300

End Sub

Private Sub Form_Unload(Cancel As Integer)
Call CloseDB
End Sub
Sub ShowInfo()
  
SumFields = rs.Fields.Count '该表的字段总数

'初始化MSFlexGrid
SearchList.Clear '清空列表，防止增加或修改调用时重复显示
SearchList.BackColor = &HC0FFFF '设置网格背景颜色
SearchList.Cols = SumFields '设置网格列数
SearchList.Row = 0
'设置第一行的各列标题
For i = 0 To SumFields - 1
    SearchList.Col = i
    SearchList.Text = rs.Fields(i).Name
Next i
  
'设置第一行的各列标题文字格式
For i = 0 To SumFields - 1
    SearchList.Col = i
    SearchList.CellAlignment = 4
    SearchList.CellFontBold = True
    SearchList.CellForeColor = vbBlue
  
    '设置标题宽度，防止部分长文字不显示
    j = TextWidth(SearchList.Text) + 200
    If j > SearchList.ColWidth(i) Then
        SearchList.ColWidth(i) = j
    End If
Next i

'循环开始--显示所有符合条件记录
rs.MoveLast
SearchList.Rows = rs.RecordCount + 1 '其中标题占一行
rs.MoveFirst

SearchList.Row = 0

While Not rs.EOF

    SearchList.Row = SearchList.Row + 1 '增加一行，用于写入内容

    For i = 0 To SumFields - 1
      SearchList.Col = i
      '读入内容
      If Not IsNull(rs.Fields(i).Value) Then
        SearchList.Text = rs.Fields(i).Value
      Else
        SearchList.Text = ""
      End If
    Next i
    
    rs.MoveNext
Wend
'循环结束--显示所有符合条件记录

rs.Close
Set rs = Nothing

lblHint.Caption = HintMsg
lblCount.Caption = "共计：" & SearchList.Row & " 人"
End Sub

Private Sub optIf_Click(Index As Integer)

If optIf(2).Value = True Then
    picFrontBehind.Visible = True
    optTheDay.Value = True
Else
    picFrontBehind.Visible = False
End If

If optIf(5).Value = True Then
    PicBigSmall.Visible = True
    OptBig.Value = True
Else
    PicBigSmall.Visible = False
End If

If optIf(6).Value = True Then
    PicMoreLess.Visible = True
    OptLess.Value = True
Else
    PicMoreLess.Visible = False
End If

txtKeywords.SetFocus
End Sub

Private Sub txtKeywords_Change()
If Len(Trim(txtKeywords.Text)) > 0 Then
    cmdSearch.Default = True
Else
    cmdSearch.Default = False
End If
End Sub
上一页 12
⌨️ 快捷键说明

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