formzy.frm

客户资源管理软件代码,VB制作,请大家多指教

         Left            =   600
         TabIndex        =   12
         Top             =   1320
         Width           =   495
      End
      Begin VB.Shape Shape1 
         BackColor       =   &H00E0E0E0&
         BackStyle       =   1  'Opaque
         BorderStyle     =   0  'Transparent
         Height          =   135
         Left            =   600
         Top             =   480
         Width           =   1815
      End
      Begin VB.Image Image3 
         Height          =   480
         Left            =   120
         Picture         =   "FormZY.frx":4E4E
         Top             =   120
         Width           =   480
      End
      Begin VB.Label Label1 
         BackStyle       =   0  'Transparent
         Caption         =   "操作:"
         Height          =   255
         Left            =   600
         TabIndex        =   10
         Top             =   840
         Width           =   495
      End
      Begin VB.Label Label2 
         BackStyle       =   0  'Transparent
         Caption         =   "用户:"
         Height          =   255
         Left            =   600
         TabIndex        =   9
         Top             =   1080
         Width           =   495
      End
   End
   Begin VB.Menu numXZYH 
      Caption         =   "新增用户(&N)"
   End
   Begin VB.Menu numJLCX 
      Caption         =   "记录查询(&C)"
      Begin VB.Menu numWXJL 
         Caption         =   "维修记录"
      End
      Begin VB.Menu numHFJL 
         Caption         =   "回访记录"
      End
   End
   Begin VB.Menu numSJWH 
      Caption         =   "数据维修(&D)"
      Begin VB.Menu numSJBF 
         Caption         =   "数据备份"
      End
      Begin VB.Menu numSJHY 
         Caption         =   "数据还原"
      End
      Begin VB.Menu fengef 
         Caption         =   "-"
      End
      Begin VB.Menu numExcel 
         Caption         =   "导出Excel"
      End
   End
   Begin VB.Menu numXTSZ 
      Caption         =   "用户设置(&T)"
      Begin VB.Menu numMMXG 
         Caption         =   "密码修改"
      End
      Begin VB.Menu numYHGL 
         Caption         =   "用户管理"
      End
   End
End
Attribute VB_Name = "FormZY"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False



Dim sql As String
Dim addlist As ListItem


Private Sub cmdCZ_Click()
Me.ListView1.ListItems.Clear '先清空listview
If Me.Combo1.Text = "" Or txtCZ.Text = "" Then
   sql = "select yhid,gjrq,lxr,pym,yhdh,yhsj,yhlx,yhdw,zjxh,zjbh,xsqxh,xsqbh from yhda ORDER BY yhid DESC"
   Call addXX
Else
   Dim xmmc As String '项目名称
   If Me.Combo1.Text = "用户编号" Then xmmc = "yhid"
   If Me.Combo1.Text = "购机日期" Then xmmc = "gjrq"
   If Me.Combo1.Text = "联系人" Then xmmc = "lxr"
   If Me.Combo1.Text = "拼音码" Then xmmc = "pym"
   If Me.Combo1.Text = "用户电话" Then xmmc = "yhdh"
   If Me.Combo1.Text = "用户手机" Then xmmc = "yhsj"
   If Me.Combo1.Text = "用户类型" Then xmmc = "yhlx"
   If Me.Combo1.Text = "用户单位" Then xmmc = "yhdw"
   If Me.Combo1.Text = "主机型号" Then xmmc = "zjxh"
   If Me.Combo1.Text = "主机编号" Then xmmc = "zjbh"
   If Me.Combo1.Text = "显示器型号" Then xmmc = "xsqxh"
   If Me.Combo1.Text = "显示器编号" Then xmmc = "xsqbh"

   sql = "select yhid,gjrq,lxr,pym,yhdh,yhsj,yhlx,yhdw,zjxh,zjbh,xsqxh,xsqbh from yhda where " & xmmc & " like '%" & txtCZ.Text & "%' order by yhid desc"
   Call addXX
End If
End Sub

Private Sub cmdQC_Click()
txtCZ.Text = ""
Me.ListView1.ListItems.Clear
sql = "select yhid,gjrq,lxr,pym,yhdh,yhsj,yhlx,yhdw,zjxh,zjbh,xsqxh,xsqbh from yhda order by yhid desc"
Call addXX
End Sub

Private Sub Form_Activate()
Me.StatusBar1.Panels(1) = xtmc
Me.StatusBar1.Panels(2) = "权限: " & czyqx
labCZY.Caption = czy '操作员
End Sub

Private Sub Form_Load()

Me.Picture1.Picture = LoadPicture(App.Path & "\bg\bg4.bmp")
Me.Picture2.Picture = LoadPicture(App.Path & "\bg\bg1.bmp")
Me.Picture3.Picture = LoadPicture(App.Path & "\bg\bg5.bmp")

If czyqx = "业务员" Then
   numSJHY.Visible = False
   numYHGL.Visible = False
End If
Me.Caption = xtmc

'增加list1 列标头
Me.ListView1.ColumnHeaders.Add = "编号"
Me.ListView1.ColumnHeaders.Add = "购机日期"
Me.ListView1.ColumnHeaders.Add = "联系人"
Me.ListView1.ColumnHeaders.Add = "拼音码"
Me.ListView1.ColumnHeaders.Add = "用户电话"
Me.ListView1.ColumnHeaders.Add = "用户手机"
Me.ListView1.ColumnHeaders.Add = "用户类型"
Me.ListView1.ColumnHeaders.Add = "用户单位"
Me.ListView1.ColumnHeaders.Add = "主机型号"
Me.ListView1.ColumnHeaders.Add = "主机编号"
Me.ListView1.ColumnHeaders.Add = "显示器型号"
Me.ListView1.ColumnHeaders.Add = "显示器编号"
'列标头宽度
Me.ListView1.ColumnHeaders(1).Width = 1200
Me.ListView1.ColumnHeaders(2).Width = 1200
Me.ListView1.ColumnHeaders(3).Width = 1200
Me.ListView1.ColumnHeaders(4).Width = 1000
Me.ListView1.ColumnHeaders(5).Width = 1500
Me.ListView1.ColumnHeaders(6).Width = 1500
Me.ListView1.ColumnHeaders(7).Width = 1200
Me.ListView1.ColumnHeaders(8).Width = 2400
Me.ListView1.ColumnHeaders(9).Width = 2000
Me.ListView1.ColumnHeaders(10).Width = 2000
Me.ListView1.ColumnHeaders(11).Width = 2000

'列标头图标
Me.ListView1.ColumnHeaderIcons = ImageList1 '首先为列标头关联图标
Me.ListView1.ColumnHeaders(1).Icon = 3

'调用过程添加到列表listview~~~~~~~~~~~~~~~~~~~~~~~

  sql = "select yhid,gjrq,lxr,pym,yhdh,yhsj,yhlx,yhdw,zjxh,zjbh,xsqxh,xsqbh from yhda ORDER BY yhid DESC"
  Call addXX


'统计信息~~~~~~~~~~~~~~~~~~~~~

'记录用户数~~~~~~~~~~~~~~~~
Call OpenConn
  sql = "select count(*) as yhjs from yhda"
  rs.Open sql, cn, 1, 1
  
     labTJ.Caption = rs.Fields("yhjs") & " 人"

Call CloseConn

'维修数~~~~~~~~~~~~~~~~~~~~~~~~~~~
Call OpenConn
  sql = "select count(*) as wxjs from wxb"
  rs.Open sql, cn, 1, 1
 
     labWX.Caption = rs.Fields("wxjs") & " 次"
  
Call CloseConn

'回访数~~~~~~~~~~~~~~~~~~~~~~~~~~~
Call OpenConn
  sql = "select count(*) as hfjs from hfb"
  rs.Open sql, cn, 1, 1
 
     labHF.Caption = rs.Fields("hfjs") & " 次"

Call CloseConn
'本月维修~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Call OpenConn
  dqrq = Left(Date, 7) '当前日期
  sql = "select count(*) as bywx from wxb where wgrq like '%" & dqrq & "%'"
  rs.Open sql, cn, 1, 1
 
   labBYWX.Caption = rs.Fields("bywx") & " 次"

Call CloseConn


'本月回访~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Call OpenConn
  dqrq = Left(Date, 7) '当前日期
  sql = "select count(*) as byhf from hfb where hfrq like '%" & dqrq & "%'"
  rs.Open sql, cn, 1, 1
 
    labBYHF.Caption = rs.Fields("byhf") & " 次"

Call CloseConn



'添加查找可用项目~~~~~~~~~~~
With Combo1
.AddItem "用户编号"
.AddItem "购机日期"
.AddItem "联系人"
.AddItem "拼音码"
.AddItem "用户电话"
.AddItem "用户手机"
.AddItem "用户类型"
.AddItem "用户单位"
.AddItem "主机型号"
.AddItem "主机编号"
.AddItem "显示器型号"
.AddItem "显示器编号"
End With

End Sub

Private Sub Form_Resize()
If Me.Width > 10350 Or Me.Height > 7440 Then
   Me.ListView1.Width = Me.ScaleWidth - 2655
   Me.ListView1.Height = Me.ScaleHeight - 1550
   Me.Picture2.Width = Me.ScaleWidth - 2655
   Me.Picture3.Height = Me.ScaleHeight - 690
   
End If
End Sub





Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)


'listview1点击列标头排序功能~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
With ListView1
If (ColumnHeader.Index - 1) = .SortKey Then
.SortOrder = (.SortOrder + 1) Mod 2
Else
.Sorted = False
.SortOrder = 0
.SortKey = ColumnHeader.Index - 1
.Sorted = True
End If
End With

End Sub

Private Sub ListView1_DblClick()
If ListView1.ListItems.Count <= 0 Then Exit Sub
yhxhcd = ListView1.SelectedItem
FormYHXX.Show 1
End Sub

Private Sub numExcel_Click()
k = 0
picLOAD.Visible = True
Call OpenConn
    If Me.Combo1.Text = "" Or txtCZ.Text = "" Then
   sql = "select * from yhda ORDER BY yhid"
 Else
   Dim xmmc As String '项目名称
   If Me.Combo1.Text = "用户编号" Then xmmc = "yhid"
   If Me.Combo1.Text = "购机日期" Then xmmc = "gjrq"
   If Me.Combo1.Text = "联系人" Then xmmc = "lxr"
   If Me.Combo1.Text = "拼音码" Then xmmc = "pym"
   If Me.Combo1.Text = "用户电话" Then xmmc = "yhdh"
   If Me.Combo1.Text = "用户手机" Then xmmc = "yhsj"
   If Me.Combo1.Text = "用户类型" Then xmmc = "yhlx"
   If Me.Combo1.Text = "用户单位" Then xmmc = "yhdw"
   If Me.Combo1.Text = "主机型号" Then xmmc = "zjxh"
   If Me.Combo1.Text = "主机编号" Then xmmc = "zjbh"
   If Me.Combo1.Text = "显示器型号" Then xmmc = "xsqxh"
   If Me.Combo1.Text = "显示器编号" Then xmmc = "xsqbh"
   sql = "select * from yhda where " & xmmc & " like '%" & txtCZ.Text & "%' order by yhid desc"
 End If
 rs.Open sql, cn, 1, 1
   If rs.RecordCount <= 0 Then
     MsgBox "没有可以导出的记录！", 48, "错误提示"
     Exit Sub
   Else
   Call OpenExcel
   '添加excel列头~~~~~~~~~~~~~~~~~~~~~~~
   mysheet.Cells(1, 1) = "客户档案"
   mysheet.Cells(2, 1) = "用户编号"
   mysheet.Cells(2, 2) = "联系人"
   mysheet.Cells(2, 3) = "拼音码"
   mysheet.Cells(2, 4) = "用户类型"
   mysheet.Cells(2, 5) = "用户单位"
   mysheet.Cells(2, 6) = "用户地址"
   mysheet.Cells(2, 7) = "邮政编号"
   mysheet.Cells(2, 8) = "用户电话"
   mysheet.Cells(2, 9) = "用户手机"
   mysheet.Cells(2, 10) = "主机型号"
   mysheet.Cells(2, 11) = "主机编号"
   mysheet.Cells(2, 12) = "显示器型号"
   mysheet.Cells(2, 13) = "显示器编号"
   mysheet.Cells(2, 14) = "购机日期"
   mysheet.Cells(2, 15) = "建档人"
   mysheet.Cells(2, 16) = "备注"
   
   j = 3
  Do While Not rs.EOF
     For i = 0 To rs.Fields.Count - 1
       mysheet.Cells(j, i + 1) = rs.Fields(i).Value
     Next i
    j = j + 1
    rs.MoveNext
     k = k + 1
    Me.ProgressBar1.Value = Format(k / rs.RecordCount, "0.00") * 100
  Loop
   End If
 picLOAD.Visible = False
 ProgressBar1.Value = 0
 myexcel.Visible = True
 Call CloseConn
 Call CloseExcel
End Sub

Private Sub numHFJL_Click()
FormHFJL.Show 1
End Sub

Private Sub numSJBF_Click()
On Error GoTo ERR_line
newname = App.Path & "\data\data.cc"
datapath = App.Path & "\backup\" & Date & " 备份卡.bak"
FileCopy newname, datapath
MsgBox "数据已备份到  " & datapath, 48, "提示"
Exit Sub
ERR_line:
MsgBox "不能完成数据备份，请进入系统后未做任何操作时进行！", 48, "运行错误"
End Sub

Private Sub numSJHY_Click()
On Error GoTo ERR_line
  Me.CommonDialog1.ShowOpen
  snewname = Me.CommonDialog1.FileName
  sdatapath = App.Path & "\data\data.cc"
  If snewname <> "" Then
    If MsgBox("还原后将覆盖原有数据，确定还原吗?", vbInformation + vbYesNo, "提示") = vbYes Then
       FileCopy snewname, sdatapath
       MsgBox "数据已经成功还原！请重新登陆 ", 48, "提示"
       Unload Me
       Formlogin.Show
    Else
       Exit Sub
    End If
End If
Exit Sub
ERR_line:
MsgBox "不能完成数据还原，请进入系统后未做任何操作时进行！", 48, "运行错误"
End Sub

Private Sub numWXJL_Click()
FormWXJL.Show 1
End Sub

Private Sub numMMXG_Click()
FormMMXG.Show 1
End Sub

Private Sub numXZYH_Click()
FormXZYH.Show 1
End Sub





Private Sub numYHGL_Click()
FormYHGL.Show 1
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Index
   Case Is = 2
     numXZYH_Click
   Case Is = 4
     numWXJL_Click
   Case Is = 5
     numHFJL_Click
   Case Is = 7
     numExcel_Click
   Case Is = 8
    If Dir(App.Path & "\data\calc.exe") <> "" Then
      Shell App.Path & "\data\calc.exe", vbNormalFocus
    Else
      MsgBox "无法找到该文件", 48, "打开失败"
    End If
End Select
End Sub


Private Sub addXX()
'取出数据添加到列表listview~~~~~~~~~~~~~~~~~~~~~~~
Call OpenConn
  rs.Open sql, cn, 1, 1
  Do While Not rs.EOF
  If rs.Fields("yhlx") = "个人" Then
     tx = 1
  Else
     tx = 2
  End If
       Set addlist = ListView1.ListItems.Add(, , rs.Fields("yhid"), , tx) '将各项数据加入list列表
       addlist.SubItems(1) = rs.Fields("gjrq")
       addlist.SubItems(2) = rs.Fields("lxr")
       addlist.SubItems(3) = rs.Fields("pym")
       addlist.SubItems(4) = rs.Fields("yhdh")
       addlist.SubItems(5) = rs.Fields("yhsj")
       addlist.SubItems(6) = rs.Fields("yhlx")
       addlist.SubItems(7) = rs.Fields("yhdw")
       addlist.SubItems(8) = rs.Fields("zjxh")
       addlist.SubItems(9) = rs.Fields("zjbh")
       addlist.SubItems(10) = rs.Fields("xsqxh")
       addlist.SubItems(11) = rs.Fields("xsqbh")
       rs.MoveNext
    Loop
Call CloseConn
End Sub