form5.frm

软件用到的技巧：透明窗体

      TabIndex        =   6
      Top             =   165
      Width           =   540
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "查找条件："
      Height          =   180
      Left            =   1440
      TabIndex        =   4
      Top             =   165
      Width           =   900
   End
End
Attribute VB_Name = "FrmShowAllRen"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/12/24
'描    述：商务名片及客户资料管理系统 Ver 1.73
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Option Explicit

Private Sub Command1_Click()
    Dim sqlstr As String

    If Combo1.Text = "性别" Then
        If Trim(Text1.Text) = "男" Then
            MsgBox "男"
            sqlstr = "select * from ren where 性别 ='1' order by id desc"
            ShowAllRen (sqlstr)
            Exit Sub
        ElseIf Trim(Text1.Text) = "女" Then
            sqlstr = "select * from ren where 性别 ='2' order by id desc"
            ShowAllRen (sqlstr)
            Exit Sub
        ElseIf Trim(Text1.Text) = "" Then
            sqlstr = "select * from ren where 性别='0' or isnull(性别) order by id desc"
            ShowAllRen (sqlstr)
            Exit Sub
        End If
    End If
    If Trim(Text1.Text) = "" Then
        Text1.Text = Trim(Text1.Text)
        Text1.SetFocus
        Exit Sub
    End If
    sqlstr = "select * from ren where " & Combo1.Text & " like '*" & Trim(Text1.Text) & "*' " & " order by ID desc"
    ShowAllRen (sqlstr)
End Sub

Private Sub Command2_Click()
    ShowAllRen ("select * from ren order by id desc")
End Sub

Private Sub Command3_Click()
    Load FrmRenAdd
    FrmRenAdd.Show

End Sub

Private Sub Command4_Click()
    If (Me.MSFlexGrid1.Rows - 1) = 0 Then
        Exit Sub
    End If
    If Trim(Me.MSFlexGrid1.TextMatrix(0, 0)) = "" Then
        Exit Sub
    End If
    Load FrmToExcel
    FrmToExcel.Show
    FrmToExcel.Label8.Caption = "2" '数据来源的标志变量，2 表示是联系人窗体调用的。
    FrmToExcel.Label7.Caption = Me.Label1.Caption  'SQL 语句。
    FrmToExcel.Label6.Caption = Me.MSFlexGrid1.Rows - 1
    FrmToExcel.Label5.Caption = "联系人列表窗体中的数据"

End Sub

Private Sub Command5_Click()
If Me.MSFlexGrid1.RowSel = 0 Then
    MsgBox "没有选中行，所以不能进行隐藏行的操作。", vbInformation
    Exit Sub
End If
If Me.MSFlexGrid1.RowSel > 0 And Me.MSFlexGrid1.RowSel > 1 Then
    If MsgBox("你将要隐藏【" & Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.RowSel, 1) & "】的资料吗？", vbQuestion + vbYesNo + vbDefaultButton2) = vbYes Then
        Me.MSFlexGrid1.RemoveItem (Me.MSFlexGrid1.RowSel)
    Else
        Exit Sub
    End If
Else
    'MsgBox "最后一条信息，不能再删除了，否则就没有什么信息可以供导出的了。", vbInformation
    MsgBox "非常抱歉，由于技术上的原因，目前此版本暂时无法删除第一行数据，这个问题后续版本有望解决，请及时关注下一版本。", vbInformation
    
End If


End Sub

Private Sub Command6_Click()
    If Val(Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.RowSel, 0)) <> 0 Then
        Dim db As Database
        Dim rs As Recordset
        Set db = OpenDatabase(MdbPath)
        Set rs = db.OpenRecordset("select 所属企业 from ren where id =" & Val(Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.RowSel, 0)))
        If rs.RecordCount = 0 Then
            MsgBox "定位数据出错，在数据库中没有找到这个联系人编号。尝试重新启动程序，如果问题依旧，可能是数据库出现了紊乱，请和软件提供者联系。", vbCritical
            rs.Close
            db.Close
            Set rs = Nothing
            Set db = Nothing
        ElseIf rs.RecordCount > 0 Then
            rs.MoveLast: rs.MoveFirst
            If rs.RecordCount > 1 Then
                MsgBox "定位数据出错，在数据库中找到了重复的这个联系人编号。尝试重新启动程序，如果问题依旧，可能是数据库出现了紊乱，请和软件提供者联系。", vbCritical
                rs.Close
                db.Close
                Set rs = Nothing
                Set db = Nothing
            ElseIf rs.RecordCount = 1 Then
                If Val(rs!所属企业) = 0 Then
                    MsgBox "没有为这个联系人定义所属单位，无法查看所属单位的信息。", vbInformation
                Else
                    EditComInfo Val(rs!所属企业)
                End If
            End If
        End If
    End If
End Sub

Private Sub Command7_Click()
    If Val(Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.RowSel, 0)) <> 0 Then
        Dim db As Database
        Dim rs As Recordset
        Set db = OpenDatabase(MdbPath)
        Set rs = db.OpenRecordset("select 所属企业 from ren where id =" & Val(Me.MSFlexGrid1.TextMatrix(Me.MSFlexGrid1.RowSel, 0)))
        If rs.RecordCount = 0 Then
            MsgBox "定位数据出错，在数据库中没有找到这个联系人编号。尝试重新启动程序，如果问题依旧，可能是数据库出现了紊乱，请和软件提供者联系。", vbCritical
            rs.Close
            db.Close
            Set rs = Nothing
            Set db = Nothing
        ElseIf rs.RecordCount > 0 Then
            rs.MoveLast: rs.MoveFirst
            If rs.RecordCount > 1 Then
                MsgBox "定位数据出错，在数据库中找到了重复的这个联系人编号。尝试重新启动程序，如果问题依旧，可能是数据库出现了紊乱，请和软件提供者联系。", vbCritical
                rs.Close
                db.Close
                Set rs = Nothing
                Set db = Nothing
            ElseIf rs.RecordCount = 1 Then
                If Val(rs!所属企业) = 0 Then
                    MsgBox "没有为这个联系人定义所属单位，无法查看所属单位的信息。", vbInformation
                Else
                    ShowComBaifang Val(rs!所属企业)
                End If
            End If
        End If
    End If

End Sub

Private Sub Form_Load()
    frmshowallrenshow = True
    HookWheel Me.hwnd '用于支持鼠标滚轮
        Me.Icon = MDIForm1.Icon
    Me.BackColor = FormBackColor: Me.Frame1.BackColor = Me.BackColor
    Me.Height = 8850
    Me.Width = 12570
    Me.Top = (Screen.Height - Me.Height) / 4
    Me.Left = (Screen.Width - Me.Width) / 2
    Combo1.ListIndex = 1

    Me.MSFlexGrid1.BackColorFixed = 16777178
    Me.MSFlexGrid1.BackColorBkg = MsFlexGridBackColorBkgValue
    MDIForm1.FromRenToBaiFang.Enabled = True
    MDIForm1.M_AddRenBaifang.Enabled = True
End Sub
Private Sub Label1_DblClick()
    Load Form11
    Form11.Show
    Form11.Text1.Text = Label1.Caption
    Form11.Combo1.ListIndex = 1
End Sub

Private Sub Form_Resize()
On Error GoTo resizeerror
    Me.Height = 8850
    Me.Width = 12570
Exit Sub
resizeerror:

End Sub
Private Sub Form_Unload(Cancel As Integer)
frmshowallrenshow = False
    AllBaiFangShow = False
End Sub
Private Sub MSFlexGrid1_GotFocus()
Set CtlWheel = MSFlexGrid1 '用于设定支持鼠标滚轮
End Sub
Private Sub MSFlexGrid1_LostFocus()
Set CtlWheel = Nothing '用于设定取消鼠标滚轮的支持
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    UnHookWheel Me.hwnd '卸载鼠标滚轮的支持
    MDIForm1.FromRenToBaiFang.Enabled = False
    MDIForm1.M_AddRenBaifang.Enabled = False
End Sub

Private Sub MSFlexGrid1_DblClick()
    If FrmShowAllRen.MSFlexGrid1.Rows = 1 Then Exit Sub
    ShowRenInfo FrmShowAllRen.MSFlexGrid1.TextMatrix(FrmShowAllRen.MSFlexGrid1.RowSel, 0)
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Command1_Click
    End If
End Sub