frmsalemanfind.frm

来自「一个优秀的售楼系统,可供毕业生毕业设计参考」· FRM 代码 · 共 277 行

FRM
277
字号
VERSION 5.00
Begin VB.Form frmsalemanfind 
   BackColor       =   &H00C0FFFF&
   Caption         =   "销售人员查询"
   ClientHeight    =   5400
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   7965
   LinkTopic       =   "Form13"
   MaxButton       =   0   'False
   ScaleHeight     =   5400
   ScaleWidth      =   7965
   StartUpPosition =   2  '屏幕中心
   Begin VB.PictureBox MSHFlexGrid1 
      Height          =   3735
      Left            =   240
      ScaleHeight     =   3675
      ScaleWidth      =   7395
      TabIndex        =   8
      Top             =   1320
      Width           =   7455
   End
   Begin VB.CommandButton cmdexit 
      Caption         =   "退出"
      Height          =   375
      Left            =   6840
      TabIndex        =   7
      Top             =   840
      Width           =   855
   End
   Begin VB.CommandButton cmdprint 
      Caption         =   "打印"
      Height          =   375
      Left            =   6840
      TabIndex        =   6
      Top             =   240
      Width           =   855
   End
   Begin VB.Frame Frame1 
      BackColor       =   &H00C0FFFF&
      Caption         =   "查询条件"
      Height          =   975
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   6495
      Begin VB.PictureBox Printgrid1 
         Height          =   480
         Left            =   5040
         ScaleHeight     =   420
         ScaleWidth      =   1140
         TabIndex        =   9
         Top             =   840
         Width           =   1200
      End
      Begin VB.CommandButton cmdfind 
         Caption         =   "查询"
         Height          =   375
         Left            =   5160
         TabIndex        =   5
         Top             =   360
         Width           =   975
      End
      Begin VB.TextBox txtname 
         Height          =   270
         Left            =   3360
         TabIndex        =   4
         Top             =   360
         Width           =   1335
      End
      Begin VB.TextBox txtnum 
         Height          =   270
         Left            =   840
         TabIndex        =   3
         Top             =   360
         Width           =   1335
      End
      Begin VB.OptionButton Option2 
         BackColor       =   &H00C0FFFF&
         Caption         =   "姓名"
         Height          =   375
         Left            =   2640
         TabIndex        =   2
         Top             =   360
         Width           =   735
      End
      Begin VB.OptionButton Option1 
         BackColor       =   &H00C0FFFF&
         Caption         =   "编号"
         Height          =   375
         Left            =   120
         TabIndex        =   1
         Top             =   360
         Width           =   735
      End
   End
End
Attribute VB_Name = "frmsalemanfind"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rs_saleman As New ADODB.Recordset
Dim rs_hetong As New ADODB.Recordset
Dim rs_huxing As New ADODB.Recordset
Dim id As String

Private Sub cmdfind_Click()
Dim sql As String
On Error GoTo loaderror
MSHFlexGrid1.Clear
If Option1.Value = True Then
   sql = "select * from 售楼人员 where 售楼人员.Sal_ID = '" & txtnum.Text & "'"
   rs_saleman.CursorLocation = adUseClient
   rs_saleman.Open sql, conn, adOpenKeyset, adLockPessimistic     '打开数据库
   setgrid
   setgridhead
   displaygrid
   rs_saleman.Close
   Exit Sub
End If
If Option2.Value = True Then
   sql = "select * from 售楼人员 where 售楼人员.Sal_name = '" & txtname.Text & "'"
   rs_saleman.CursorLocation = adUseClient
   rs_saleman.Open sql, conn, adOpenKeyset, adLockPessimistic     '打开数据库
   setgrid
   setgridhead
   displaygrid
   rs_saleman.Close
   Exit Sub
End If
Exit Sub
loaderror:
   MsgBox Err.Description
End Sub

Private Sub cmdprint_Click()
Printgrid1.Unit = Centimeter
Printgrid1.PrintObject = MSHFlexGrid1
Printgrid1.DoPreView
End Sub

Private Sub Command3_Click()
Unload Me
End Sub

Private Sub Form_Load()
Dim sql As String
On Error GoTo loaderror
sql = "select * from 售楼人员"
rs_saleman.CursorLocation = adUseClient
rs_saleman.Open sql, conn, adOpenKeyset, adLockPessimistic     '打开数据库
setgrid
setgridhead
displaygrid
rs_saleman.Close
Exit Sub
loaderror:
   MsgBox Err.Description
End Sub

Public Sub displaygrid()
Dim i As Integer
On Error GoTo displayerror
MSHFlexGrid1.Row = 0
If Not rs_saleman.EOF Then
   rs_saleman.MoveFirst
   Do While Not rs_saleman.EOF
            MSHFlexGrid1.Row = MSHFlexGrid1.Row + 1
            For i = 0 To 9
                MSHFlexGrid1.Col = i
                If Not IsNull(rs_saleman.Fields(i)) Then
                   MSHFlexGrid1.Text = rs_saleman.Fields(i)
                Else
                   MSHFlexGrid1.Text = ""
                End If
            Next i
            MSHFlexGrid1.Col = 10
            MSHFlexGrid1.Text = CStr(cal(rs_saleman.Fields(0)))
            MSHFlexGrid1.Col = 11
            MSHFlexGrid1.Text = CStr(calmoney(rs_saleman.Fields(0)))
            rs_saleman.MoveNext
   Loop
End If
displayerror:
If Err.Number <> 0 Then
   MsgBox Err.Description
End If
End Sub

Public Sub setgrid()
Dim i As Integer
On Error GoTo seterror
With MSHFlexGrid1
    .ScrollBars = flexScrollBarBoth
    .FixedCols = 1
    .Rows = rs_saleman.RecordCount + 1
    .Cols = 12
    .SelectionMode = flexSelectionByRow
For i = 0 To .Rows - 1
    .RowHeight(i) = 315
Next
For i = 0 To .Cols - 1
    .ColWidth(i) = 1300
Next i
End With
Exit Sub
seterror:
     MsgBox Err.Description
End Sub

Public Sub setgridhead()
On Error GoTo setheaderror
MSHFlexGrid1.Row = 0
MSHFlexGrid1.Col = 0
MSHFlexGrid1.Text = "编号"
MSHFlexGrid1.Col = 1
MSHFlexGrid1.Text = "身份证号"
MSHFlexGrid1.Col = 2
MSHFlexGrid1.Text = "姓名"
MSHFlexGrid1.Col = 3
MSHFlexGrid1.Text = "性别"
MSHFlexGrid1.Col = 4
MSHFlexGrid1.Text = "出生日期"
MSHFlexGrid1.Col = 5
MSHFlexGrid1.Text = "电话"
MSHFlexGrid1.Col = 6
MSHFlexGrid1.Text = "手机"
MSHFlexGrid1.Col = 7
MSHFlexGrid1.Text = "电子邮件"
MSHFlexGrid1.Col = 8
MSHFlexGrid1.Text = "邮编"
MSHFlexGrid1.Col = 9
MSHFlexGrid1.Text = "通信地址"
MSHFlexGrid1.Col = 10
MSHFlexGrid1.Text = "合同数量"
MSHFlexGrid1.Col = 11
MSHFlexGrid1.Text = "合同金额"
Exit Sub
setheaderror:
   MsgBox Err.Description
End Sub



Public Function cal(id As String) As Integer
Dim sql As String
sql = "select * from 合同 where 合同.Pct_salesID = '" & id & "'"
rs_hetong.CursorLocation = adUseClient
rs_hetong.Open sql, conn, adOpenKeyset, adLockPessimistic
cal = rs_hetong.RecordCount
rs_hetong.Close
End Function

Public Function calmoney(id As String) As Double
Dim sql As String
Dim price As Double
Dim area As Double
calmoney = 0
sql = "select * from 合同,楼盘 where 合同.Pct_salesID = '" & id & "'" & _
    " and 合同.Pct_houseID = 楼盘.hos_id "
rs_hetong.CursorLocation = adUseClient
rs_hetong.Open sql, conn, adOpenKeyset, adLockPessimistic
Do While Not rs_hetong.EOF
   price = CDbl(rs_hetong.Fields(4))
   sql = "select * from 户型 where 户型.Hst_ID = '" & rs_hetong.Fields(17) & "'"
   rs_huxing.CursorLocation = adUseClient
   rs_huxing.Open sql, conn, adOpenKeyset, adLockPessimistic
   area = CDbl(rs_huxing.Fields(1))
   calmoney = calmoney + price * area
   rs_hetong.MoveNext
   rs_huxing.Close
Loop
rs_hetong.Close
End Function

⌨️ 快捷键说明

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