main.frm

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

            Form13.Label5.Caption = "数据库读取完毕。"
        End If
        Form13.Label5.Caption = "正在关闭数据库 ... "
        rs.Close
        Set rs = db.OpenRecordset("select * from com where ID =" & renid & " order by id desc")
        If rs.RecordCount = 0 Then
            MsgBox "数据出现了致命的错误，可能数据库已经紊乱，请立即和软件作者联系。软件在读取商家的信息的时候出现了错误：返回的商家集合为空！", vbInformation, "数据处理错误"
            rs.Close
            Set rs = Nothing
            db.Close
            Set db = Nothing
            Exit Sub
            
        ElseIf rs.RecordCount = 1 Then
            rs.MoveLast
            If rs.RecordCount = 1 Then
                Form13.Text1.Text = rs!企业名称
                Form13.Text2.Text = rs!企业电话
                Form13.Text3.Text = rs!企业地址
                    If Trim(rs!邮政编码) <> "" Then
                        Form13.Text3.Text = rs!企业地址 & " （" & rs!邮政编码 & " ）"
                    End If
                Form13.Text4.Text = rs!法人代表
            End If
        ElseIf rs.RecordCount > 1 Then
            MsgBox "数据出现了致命的错误，可能数据库已经紊乱，请立即和软件作者联系。软件在读取商家的信息的时候出现了错误：返回的商家集合有多个商家！", vbInformation, "数据处理错误"
            rs.Close
            Set rs = Nothing
            db.Close
            Set db = Nothing
            Exit Sub
        End If
        rs.Close
        Set rs = Nothing
        
        db.Close
        Set db = Nothing
        Form13.Label5.Caption = "数据库加载完毕。"
        Form13.Frame3.Width = Form13.Label5.Width + 250
    End If
    Exit Sub
ddddddd:
MsgBox Err.Number & "：" & Err.Description
End Sub

Private Sub M_AddRenBaifang_Click()
    If Val(FrmShowAllRen.MSFlexGrid1.TextMatrix(FrmShowAllRen.MSFlexGrid1.RowSel, 0)) = 0 Then
        Exit Sub
    Else
        Dim d As Database
        Dim r As Recordset
        Set d = OpenDatabase(MdbPath)
        Set r = d.OpenRecordset("select * from ren where id =" & FrmShowAllRen.MSFlexGrid1.TextMatrix(FrmShowAllRen.MSFlexGrid1.RowSel, 0))
        Dim renid As Double
        If r.RecordCount > 0 Then
            r.MoveLast
            r.MoveFirst
            If r.RecordCount > 1 Then
                MsgBox "数据库出现了紊乱：当按照联系人的ID来从数据库中查询所属单位的ID的时候，找到了不唯一的记录，相同的ID的联系人应该是唯一的，数据库错误，请和程序提供者联系。", vbInformation, "不可处理的错误中断"
                r.Close
                d.Close
                Set r = Nothing
                Set d = Nothing
                Exit Sub
            ElseIf r.RecordCount = 1 Then

                If IsNull(r!所属企业) = False Then
                    renid = r!所属企业
                    r.Close
                    d.Close
                    Set r = Nothing
                    Set d = Nothing
                Else
                    renid = 0
                    r.Close
                    d.Close
                    Set r = Nothing
                    Set d = Nothing
                End If
            End If
        ElseIf r.RecordCount = 0 Then
            renid = 0
            r.Close
            d.Close
            Set r = Nothing
            Set d = Nothing
        End If
   End If
        
    If Val(renid) = 0 Then
        MsgBox "定位联系人的所属单位的ID标志的时候出现了错误，无法解析，传递过来的值为空！可能是该联系人不属于任何单位。", vbInformation, "联系人所属单位取值失败"
        Exit Sub
    End If
    FrmBaiFangAdd.Label2.Caption = Val(renid)
    FrmBaiFangAdd.Combo2.Clear
    
    AddBaiFangSub (renid)
End Sub

Private Sub M_pswdset_Click()
    Load Form16
    Form16.Show
End Sub

Private Sub MALLBAIFANGSHOW_Click()
    If AllBaiFangShow = True Then
        AllBaiFang.SetFocus
    Else
        Load AllBaiFang
        AllBaiFang.Show
        'ShowAllBaiFang ("select ID,企业ID号,拜访时间,受访人,拜访人,内容 from baifang  group by 企业ID号 order by id desc ")
            Dim db1 As Database
            Dim rs1 As Recordset
            Set db1 = OpenDatabase(MdbPath)
            Set rs1 = db1.OpenRecordset("select listnum from proset")
            Dim dbb As Database
            Dim rss As Recordset
            Set dbb = OpenDatabase(MdbPath)
            Set rss = dbb.OpenRecordset("select * from baifang")
            If rss.RecordCount > 0 Then
                rss.MoveLast
                rss.MoveFirst
            End If
            If IsNull(rs1!ListNum) = True Then
                ShowAllBaiFang ("select * from baifang order by id desc")
            ElseIf Val(rs1!ListNum) = 0 Then
                ShowAllBaiFang ("select * from baifang order by id desc")
            ElseIf Val(rs1!ListNum) > 0 Then
                If rss.RecordCount < Val(rs1!ListNum) Then
                    ShowAllBaiFang ("select * from baifang order by id desc")
                ElseIf rss.RecordCount >= Val(rs1!ListNum) Then
                    ShowAllBaiFang ("select top " & Val(rs1!ListNum) & " * from baifang order by id desc")
                End If
            End If
            rss.Close
            dbb.Close
            Set rss = Nothing
            Set dbb = Nothing
            rs1.Close
            db1.Close
            Set rs1 = Nothing
            Set db1 = Nothing
    End If
End Sub

Private Sub mcanshubengongsi_Click()
    Load Form7
    Form7.Show
End Sub

Private Sub mcanshushujukutongji_Click()
    Load frmalltongji
    frmalltongji.Show
End Sub

Private Sub mchaxundianhuahaoma_Click()
    Load Form15
    Form15.Show
End Sub

Private Sub MDIForm_Load()
    Me.M_AddRenBaifang.Enabled = False
    Me.FromRenToBaiFang.Enabled = False
    Me.ShowThisBaifang.Enabled = False
    
If CheckHangye = True Then
    CreatHangYe
End If '如果行业数据库不存在，则创建该表。
If Checkxingzhi = True Then
    CreatXingzhi
End If
Me.BackColor = RGB(12, 88, 184)
'FormBackColor = RGB(204, 232, 207)
MsFlexGridBackColorBkgValue = 16053492
On Error GoTo LoadErrorCode
    If Dir(App.Path & "\alltel.ico") <> "" Then
        Me.Icon = LoadPicture(App.Path & "\alltel.ico")
    End If
h:
    Dim db As Database
    Dim rs As Recordset
    Set db = OpenDatabase(MdbPath)
    Set rs = db.OpenRecordset("proset")
    'If rs.RecordCount = 0 Then
    '    Load FrmGongNeng
    '    FrmGongNeng.Show
    'End If
    If rs.RecordCount > 0 Then
        If IsNull(rs!gongneng) = False Then
            SetGN (Trim(rs!gongneng))
        Else
            SetGN ("是是是是是是是")
        End If
        If (IsNull(rs!yb) = True) Or (Trim(rs!yb) = "") Then
            MsgBox "本地邮编没有设置，请到设置本公司人员窗体里把邮编设置了，以后程序所用到的区别地区的功能的时候，均是以邮编为标志的，所以，邮编请务必填写准确。", vbInformation
            Load Form7
            Form7.Show
        End If
    End If
    rs.Close
    db.Close
    Set db = Nothing
    Set rs = Nothing
        Dim i     As Integer
        Dim pnlX     As Panel
        For i = 1 To 6                 '添加五个面板。
              Set pnlX = StatusBar1.Panels.Add()
        Next i
        
        
        '设置每一个面板的样式。
        With StatusBar1.Panels
              '.Item(1).Style = sbrDate
              .Item(1).Text = Format(Date, "yyyy-MM-dd") & " " & GetNongLi(Date)             '日期,
              .Item(1).Width = 3000
              .Item(2).Text = WeekName(Now)
              .Item(3).Style = sbrCaps: .Item(3).Width = 600  'Caps   锁定
              .Item(2).Width = 750
              .Item(4).Style = sbrNum: .Item(4).Width = 500           'Number   锁定
             ' .Item(5).Style = sbrIns             'Insert   键
              .Item(5).Text = "版本：" & App.Major & "." & App.Minor & "." & App.Revision: .Item(5).Width = 1200
              .Item(6).Text = "        AsAny"             'Scroll   锁定
              '.Item(6).Text = " 连云港市福恒科技有限公司"
                            .Item(6).Width = 2500
             SumNumber '求各个表中的记录数总和
             .Item(7).AutoSize = sbrSpring
        End With
    Exit Sub
LoadErrorCode:
    If Err.Number = 481 Then
        MsgBox "加载图标文件失败，图标的格式不合格，程序将使用默认的图标。", vbCritical, "图标格式错误"
        GoSub h
    Else
        MsgBox Err.Number & "：" & Err.Description, vbCritical, "错误"
    End If
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
    Dim i     As Integer
    For i = Forms.Count - 1 To 1 Step -1 'close   all   sub   forms
        Unload Forms(i)
    Next
    End Sub

Private Sub MDYBDHMD_Click()
    If form10show = True Then
        Form10.SetFocus
    Else
        Load Form10
        Form10.Show
    End If
End Sub

Private Sub mgongneng_Click()
    Load FrmGongNeng
    FrmGongNeng.Show
End Sub

Private Sub Mjilushanchu_Click()
    
    If AllBaiFangShow = False Then
        Load AllBaiFang
        AllBaiFang.Show
            Dim db1 As Database
            Dim rs1 As Recordset
            Set db1 = OpenDatabase(MdbPath)
            Set rs1 = db1.OpenRecordset("select listnum from proset")
            Dim dbb As Database
            Dim rss As Recordset
            Set dbb = OpenDatabase(MdbPath)
            Set rss = dbb.OpenRecordset("select * from baifang")
            If rss.RecordCount > 0 Then
                rss.MoveLast
                rss.MoveFirst
            End If
            If IsNull(rs1!ListNum) = True Then
                ShowAllBaiFang ("select * from baifang order by id desc")
            ElseIf Val(rs1!ListNum) = 0 Then
                ShowAllBaiFang ("select * from baifang order by id desc")
            ElseIf Val(rs1!ListNum) > 0 Then
                If rss.RecordCount < Val(rs1!ListNum) Then
                    ShowAllBaiFang ("select * from baifang order by id desc")
                ElseIf rss.RecordCount >= Val(rs1!ListNum) Then
                    ShowAllBaiFang ("select top " & Val(rs1!ListNum) & " * from baifang order by id desc")
                End If
            End If
            rss.Close
            dbb.Close
            Set rss = Nothing
            Set dbb = Nothing
            rs1.Close
            db1.Close
            Set rs1 = Nothing
            Set db1 = Nothing
    Else
        If AllBaiFang.MSFlexGrid1.TextMatrix(0, 0) = "" Then Exit Sub
        AllBaiFang.SetFocus
        If MsgBox("程序将要删除编号为：" & AllBaiFang.MSFlexGrid1.TextMatrix(AllBaiFang.MSFlexGrid1.RowSel, 0) & "、隶属于：" & AllBaiFang.MSFlexGrid1.TextMatrix(AllBaiFang.MSFlexGrid1.RowSel, 2) & " 的这条拜访记录，请确认要删除的内容，如果真的想删除，点击“是”按钮。该操作将无法恢复。", vbQuestion + vbYesNo + vbDefaultButton2, "删除操作即将执行") = vbYes Then
            Dim db As Database
            Dim rs As Recordset
            Set db = OpenDatabase(MdbPath)
            Set rs = db.OpenRecordset("select * from baifang where id=" & Val(AllBaiFang.MSFlexGrid1.TextMatrix(AllBaiFang.MSFlexGrid1.RowSel, 0)))
            If rs.RecordCount = 0 Then
                MsgBox "软件按照预定的编号到数据库中去定位拜访记录的时候出现了错误，软件返回的记录集为空。没有找到这条拜访记录。", vbInformation, "定位失败"
                rs.Close
                db.Close
                Set rs = Nothing
                Set db = Nothing
            Else
                rs.Delete
                rs.Close
                db.Close
                Set rs = Nothing
                Set db = Nothing
                ShowAllBaiFang (AllBaiFang.Label3.Caption)
                DoEvents
                AllBaiFang.MSFlexGrid1.Refresh
                DoEvents
                MsgBox "删除操作执行完毕，删除成功。", vbInformation, "删除完毕"
                SumNumber '求各个表中的记录数总和
            End If
        End If
    End If
End Sub

Private Sub Mjilutianjia_Click()
    If form2show = True Then
        If Form2.MSFlexGrid1.Rows = 1 Then
            MsgBox "没有添加商家,无法添加拜访记录,请添加商家之后再来添加拜访记录.", vbInformation, "商家不存在"
            Load Form1
            Form1.Show
            Exit Sub
        End If
        Form2.SetFocus
        FrmBaiFangAdd.Label2.Caption = Form2.MSFlexGrid1.TextMatrix(Form2.MSFlexGrid1.RowSel, 0)
        FrmBaiFangAdd.Combo2.Clear
        
        AddBaiFangSub (Form2.MSFlexGrid1.TextMatrix(Form2.MSFlexGrid1.RowSel, 0))
   Else
        Load Form2
        Form2.Show
        Dim db1 As Database
        Dim rs1 As Recordset
        Set db1 = OpenDatabase(MdbPath)
        Set rs1 = db1.OpenRecordset("select listnum from proset")
        Dim dbb As Database
        Dim rss As Recordset
        Set dbb = OpenDatabase(MdbPath)
        Set rss = dbb.OpenRecordset("select * from com")
        If rss.RecordCount > 0 Then
            rss.MoveLast
            rss.MoveFirst
        End If
        If IsNull(rs1!ListNum) = True Then
            allshow ("select * from com order by id desc")
        ElseIf Val(rs1!ListNum) = 0 Then
            allshow ("select * from com order by id desc")
        ElseIf Val(rs1!ListNum) > 0 Then
            If rss.RecordCount < Val(rs1!ListNum) Then
                allshow ("select * from com order by id desc")
            ElseIf rss.RecordCount >= Val(rs1!ListNum) Then
                allshow ("select top " & Val(rs1!ListNum) & " * from com order by id desc")
            End If
        End If
        rss.Close
        dbb.Close
        Set rss = Nothing
        Set dbb = Nothing
        rs1.Close
        db1.Close
        Set rs1 = Nothing
        Set db1 = Nothing