frmopt.frm

业务管理系统。方便业务员跟踪记录客户信息。

      End
      Begin VB.Label LabEmail 
         Caption         =   "@Email"
         Height          =   180
         Left            =   3270
         TabIndex        =   41
         Top             =   1110
         Width           =   540
      End
      Begin VB.Label LabrDate 
         Caption         =   "洽谈日期"
         Height          =   180
         Left            =   6510
         TabIndex        =   40
         Top             =   1110
         Width           =   720
      End
      Begin VB.Label LabContent 
         Caption         =   "备    注"
         Height          =   180
         Left            =   255
         TabIndex        =   39
         Top             =   3420
         Width           =   720
      End
   End
End
Attribute VB_Name = "FrmOpt"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Rst As ADODB.Recordset
Dim sCond As String

Private Sub CombCond_Click()
    
    TxtCond.Text = ""
    
    If CombCond.Text = "业务情况" Then
        CondED 1
    ElseIf CombCond.Text = "洽谈日期" Then
        CondED 2
    Else
        CondED 0
    End If

End Sub

Private Sub CombPage_Click()

    WriteGird CombPage.ListIndex + 1

End Sub

Private Sub CommCalcal_Click()
    
    FramEdit.Visible = False
    FramOpt.Visible = True
    
End Sub

Private Sub CommCondAdd_Click()

    If CombCond.ListIndex <> 4 And CombCond.ListIndex <> 5 Then
        If TxtCond.Text = "" Then
            TxtCond.SetFocus
            MsgBox "    请填写条件！    ", , "条件"
            Exit Sub
        End If
    End If
    
    Select Case CombCond.ListIndex
        Case 0
            If TxtCond.Text <> "" Then
                sCond = sCond & " AND Company LIKE '%" & TxtCond.Text & "%'"
                LabCond.Caption = LabCond.Caption & "(公司名 =" & TxtCond.Text & ")"
                TxtCond.Text = ""
            End If
        Case 1
            If TxtCond.Text <> "" Then
                sCond = sCond & " AND Linkman LIKE '%" & TxtCond.Text & "%'"
                LabCond.Caption = LabCond.Caption & "(联系人 =" & TxtCond.Text & ")"
                TxtCond.Text = ""
            End If
        Case 2
            If TxtCond.Text <> "" Then
                sCond = sCond & " AND Phone LIKE '%" & TxtCond.Text & "%'"
                LabCond.Caption = LabCond.Caption & "(电话 =" & TxtCond.Text & ")"
                TxtCond.Text = ""
            End If
        Case 3
            If TxtCond.Text <> "" Then
                sCond = sCond & " AND Address LIKE '%" & TxtCond.Text & "%'"
                LabCond.Caption = LabCond.Caption & "(地址 =" & TxtCond.Text & ")"
                TxtCond.Text = ""
            End If
        Case 4
            sCond = sCond & " AND Status = " & CombStatus.ListIndex
            LabCond.Caption = LabCond.Caption & "(状态 =" & CombStatus.Text & ")"
        Case 5
            sCond = sCond & " AND tDate ='" & FormatDT(DTCond.Value) & "'"
            LabCond.Caption = LabCond.Caption & "(洽谈日期 =" & FormatDT(DTCond.Value) & ")"
        Case 6
            If TxtCond.Text <> "" Then
                sCond = sCond & " AND Email LIKE '%" & TxtCond.Text & "%'"
                LabCond.Caption = LabCond.Caption & "(Email =" & TxtCond.Text & ")"
                TxtCond.Text = ""
            End If
        Case 7
            If TxtCond.Text <> "" Then
                sCond = sCond & " AND Content LIKE '%" & TxtCond.Text & "%'"
                LabCond.Caption = LabCond.Caption & "(备注 =" & TxtCond.Text & ")"
                TxtCond.Text = ""
            End If
    End Select
    
End Sub

Private Sub CommCondClear_Click()
    
    sCond = ""
    LabCond.Caption = ""
    InstComb
    
End Sub

Private Sub CommDel_Click()
    
    Dim Msg As Long
    Msg = MsgBox("    真的要删除 [" & ListVW.SelectedItem.Text & "] 吗？    ", vbYesNo, "删除")
    If Msg = vbYes Then
        Rst.AbsolutePosition = (LabStatue(4).Caption - 1) * 10 + ListVW.SelectedItem.Index
        ListVW.ListItems.Remove ListVW.SelectedItem.Key
        Rst.Delete
        getSatus
        WriteGird LabStatue(4).Caption
    End If
    
End Sub

Private Sub CommEdit_Click()
    
    ClearEdit
    FramOpt.Visible = False
    FramEdit.Visible = True
    With ListVW.SelectedItem
        TxtComp.Text = .Text
        TxtLinkm.Text = .SubItems(3)
        TxtEmail.Text = .SubItems(6)
        DT_ckdate.Value = .SubItems(2)
        TxtPhone.Text = .SubItems(4)
        If .SubItems(1) = "没有开始" Then
            CombOk.ListIndex = 0
        ElseIf .SubItems(1) = "进 行 中" Then
            CombOk.ListIndex = 1
        Else
            CombOk.ListIndex = 2
        End If
        TxtAddress.Text = .SubItems(5)
        TxtContent.Text = .SubItems(7)
    End With
    
End Sub

Private Sub CommEditOK_Click()
    
    Dim Sql As String
    Dim Rst As New ADODB.Recordset
    
    On Error GoTo ERR
    
    'Sql = "SELECT Company FROM Operation WHERE Company='" & ClearStr(TxtComp.Text) & "'"
    'Set Rst = Conn.Execute(Sql)
    'If Rst.EOF Then
        Sql = "UPDATE Operation SET " _
              & "Company='" & ClearStr(TxtComp.Text) & "'," _
              & "Linkman='" & ClearStr(TxtLinkm.Text) & "'," _
              & "Address='" & ClearStr(TxtAddress.Text) & "'," _
              & "Phone='" & ClearStr(TxtPhone.Text) & "'," _
              & "Email='" & ClearStr(TxtEmail.Text) & "'," _
              & "tDate='" & FormatDT(DT_ckdate.Value) & "'," _
              & "[upDate]='" & FormatDT(Date) & "'," _
              & "Status='" & CombOk.ListIndex & "'," _
              & "Content='" & ClearStr(TxtContent.Text) & "' " _
              & "WHERE ID=" & Right(ListVW.SelectedItem.Key, Len(ListVW.SelectedItem.Key) - 3)
        Conn.Execute Sql
    'Else
    '    MsgBox "    此公司名称已经存在！    "
    '    Exit Sub
    'End If
    With ListVW.SelectedItem
          .Text = ClearStr(TxtComp.Text)
          .SubItems(3) = ClearStr(TxtLinkm.Text)
          .SubItems(5) = ClearStr(TxtAddress.Text)
          .SubItems(4) = ClearStr(TxtPhone.Text)
          .SubItems(6) = ClearStr(TxtEmail.Text)
          .SubItems(2) = FormatDT(DT_ckdate.Value)
          .SubItems(1) = CombOk.Text
          .SubItems(7) = ClearStr(TxtContent.Text)
    End With
    
    FramEdit.Visible = False
    FramOpt.Visible = True
    
    Exit Sub
ERR:
    MsgBox ERR.Description
    
End Sub

Private Sub CommExit_Click()
        
    Unload Me
    
End Sub

Private Sub CommPN_Click(Index As Integer)
    
    Dim intPage As Integer
    
    Select Case Index
        Case 0
            intPage = 1
        Case 1
            intPage = CombPage.Text - 1
        Case 2
            intPage = CombPage.Text + 1
        Case 3
            intPage = Rst.PageCount
        Case 4
            intPage = LabStatue(4).Caption
    End Select
    If intPage < 1 Then
        intPage = 1
    ElseIf intPage > Rst.PageCount Then
        intPage = Rst.PageCount
    End If
    If Index = 4 Then
        If Rst.PageCount > 0 Then
            LabStatue(4).Caption = intPage
        Else
            LabStatue(4).Caption = 0
        End If
    End If
    If Rst.RecordCount > 0 Then
        CombPage.ListIndex = intPage - 1
    End If
    
End Sub

Private Sub CommQuery_Click()
    
    Dim Sql As String
    Dim i As Long
    
    On Error GoTo ERR
    
    ListVW.ListItems.Clear
    
    Set Rst = Nothing
    Set Rst = New ADODB.Recordset
    
    Select Case CombOrder.ListIndex
        Case 0
            Sql = ""
        Case 1
            Sql = " ORDER BY Company"
        Case 2
            Sql = " ORDER BY Status"
        Case 3
            Sql = " ORDER BY tDate"
    End Select
    
    Sql = "SELECT * FROM Operation WHERE 1 " & sCond & Sql
    
    Rst.Open Sql, Conn, adOpenKeyset, adLockOptimistic
    
    getSatus
    
    Exit Sub
ERR:
    Set Rst = Nothing
    MsgBox ERR.Description
    
End Sub

Private Sub edComPN(bl As Boolean)
    
    Dim i As Byte
    
    For i = 0 To 3
        CommPN(i).Enabled = bl
    Next
    CombPage.Enabled = bl
    CommEdit.Enabled = bl
    CommDel.Enabled = bl
    
End Sub


Private Sub getSatus()

    LabStatue(7).Caption = Rst.RecordCount
    
    Rst.PageSize = 10
    LabStatue(1).Caption = Rst.PageCount
    
    CombPage.Clear
    For i = 0 To Rst.PageCount - 1
        CombPage.AddItem i + 1
    Next
    
    CommPN_Click 4
    
    If Rst.RecordCount > 0 Then
        edComPN True
    Else
        edComPN False
    End If
    
End Sub

Private Sub Form_Load()

    EButton "000"
    
    edComPN False
    
    GetFrm Me, "Opt", 200, 600, 9705, 5760
    
    With ListVW.ColumnHeaders
        .Add , "Company", "公司名称", GetSetting("Operation", "Opt", "lvCompany", "2500")
        .Add , "Status", "业务情况", GetSetting("Operation", "Opt", "lvStatus", "1000")
        .Add , "tDate", "洽谈日期", GetSetting("Operation", "Opt", "lvtDate", "1000")
        .Add , "LinkMan", "联系人", GetSetting("Operation", "Opt", "lvLinkman", "800")
        .Add , "Phone", "电话", GetSetting("Operation", "Opt", "lvPhone", "800")
        .Add , "Address", "详细地址", GetSetting("Operation", "Opt", "lvAddress", "1500")
        .Add , "Email", "@Email", GetSetting("Operation", "Opt", "lvEmail", "2500")
        .Add , "Content", "备注", GetSetting("Operation", "Opt", "lvContent", "2500")
    End With
    With CombOrder
        .AddItem "排    序"
        .AddItem "公司名称"
        .AddItem "业务情况"
        .AddItem "洽谈日期"
        .ListIndex = 0
    End With
    InstComb
    With CombStatus
        .AddItem "没有开始"
        .AddItem "进 行 中"
        .AddItem "洽谈成功"
        .ListIndex = 0
    End With
    
    DTCond.Value = Date
    
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    
    Set Rst = Nothing
    
End Sub

Private Sub Form_Unload(Cancel As Integer)

    EButton "111"
    
    SaveFrm Me, "Opt"
    
End Sub

Private Sub CondED(Idx As Byte)

    DTCond.Visible = False
    TxtCond.Enabled = False
    CombStatus.Visible = False
    
    If Idx = 0 Then
        TxtCond.Enabled = True
    ElseIf Idx = 1 Then
        CombStatus.Visible = True
    Else
        DTCond.Visible = True
    End If
    
End Sub

Private Sub InstComb()
    
    With CombCond
        .Clear
        .AddItem "公司名称"
        .AddItem "联 系 人"
        .AddItem "电    话"
        .AddItem "详细地址"
        .AddItem "业务情况"
        .AddItem "洽谈日期"
        .AddItem "@  Email"
        .AddItem "备    注"
        .ListIndex = 0
    End With
    CondED 0
    
End Sub

Private Sub WriteGird(intPage As Integer)
    
    If intPage < 1 Then Exit Sub
    
    Dim i As Integer
    Dim j As Integer
    
    LabStatue(4).Caption = intPage
    Rst.AbsolutePage = intPage
    
    With ListVW
    .ListItems.Clear
    For i = 0 To 9
        .ListItems.Add , "Key" & Rst(0).Value, Rst(1).Value, , 1
        For j = 2 To 8
            .ListItems("Key" & Rst(0).Value).SubItems(j - 1) = Rst(j).Value
        Next
        .ListItems("Key" & Rst(0).Value).SubItems(1) = GetStatus(Rst(2).Value)
        Rst.MoveNext
        If Rst.EOF Then Exit Sub
    Next
    End With
    
End Sub

Private Function GetStatus(Idx As Byte)

    If Idx = 0 Then
        GetStatus = "没有开始"
    ElseIf Idx = 1 Then
        GetStatus = "进 行 中"
    Else
        GetStatus = "洽谈成功"
    End If
        
End Function

Private Sub ClearEdit()

    DT_ckdate.Value = Date
    
    With CombOk
        .Clear
        .AddItem "没有开始"
        .AddItem "进 行 中"
        .AddItem "洽谈成功"
        .ListIndex = 0
    End With
    TxtComp.Text = ""
    TxtLinkm.Text = ""
    TxtEmail.Text = ""
    TxtPhone.Text = ""
    TxtAddress.Text = ""
    TxtContent.Text = ""
    
End Sub