frm_jsryzj.frm

美容院管理系统

         SubItemIndex    =   1
         Text            =   "卡号"
         Object.Width           =   2469
      EndProperty
      BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   2
         Text            =   "项目"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   3
         Text            =   "介绍人"
         Object.Width           =   1764
      EndProperty
      BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   4
         Text            =   "客人姓名"
         Object.Width           =   1764
      EndProperty
      BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Alignment       =   1
         SubItemIndex    =   5
         Text            =   "收入(￥)"
         Object.Width           =   1764
      EndProperty
      BeginProperty ColumnHeader(7) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         Alignment       =   2
         SubItemIndex    =   6
         Text            =   "支付方式"
         Object.Width           =   1764
      EndProperty
      BeginProperty ColumnHeader(8) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
         SubItemIndex    =   7
         Text            =   "备注"
         Object.Width           =   2540
      EndProperty
   End
   Begin VB.Label Label2 
      BackColor       =   &H00C0E0FF&
      BorderStyle     =   1  'Fixed Single
      Height          =   255
      Left            =   135
      TabIndex        =   14
      Top             =   1335
      Width           =   8760
   End
End
Attribute VB_Name = "frm_jsryzj"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rec As Recordset
Dim itmx As ListItem
Dim sqlstr As String
Dim col As ColumnHeader

Private Sub OKButton_Click()

End Sub

Private Sub Check1_Click()
    ListView1.ColumnHeaders.Clear
    ListView1.ListItems.Clear

If Check1.Value = 1 Then
    Combo1.ListIndex = 0
    Combo1.Enabled = False
    Command1(2).Enabled = False

    Set col = ListView1.ColumnHeaders.Add(, , "介绍人", 1200)
    Set col = ListView1.ColumnHeaders.Add(, , "总收入(￥)", 1400, 1)
    
Else
    Combo1.Enabled = True
    'Command1(2).Enabled = True
    Set col = ListView1.ColumnHeaders.Add(, , "日期", 1100)
    Set col = ListView1.ColumnHeaders.Add(, , "卡号", 600, 1)
    Set col = ListView1.ColumnHeaders.Add(, , "项目", 1400, 0)
    Set col = ListView1.ColumnHeaders.Add(, , "介绍人", 1000, 0)
    Set col = ListView1.ColumnHeaders.Add(, , "客人姓名", 1000, 0)
    Set col = ListView1.ColumnHeaders.Add(, , "收入(￥)", 1000, 1)
    Set col = ListView1.ColumnHeaders.Add(, , "支付方式", 1000, 2)
    Set col = ListView1.ColumnHeaders.Add(, , "备注", 1400, 0)
End If
End Sub

Private Sub Command1_Click(Index As Integer)
'On Error GoTo jgqerr
Select Case Index
Case 4
    If Check1.Value = 1 And ListView1.ListItems.Count <> 0 Then
With frm_graph
    .mschart1.ColumnCount = ListView1.ListItems.Count
    .mschart1.RowCount = 1
    .mschart1.Row = 1
    .mschart1.RowLabel = Format(DTPicker1(0).Value, "yyyy年-mm月-dd日") + " --- " + Format(DTPicker1(1).Value, "yyyy年-mm月-dd日")
    .mschart1.TitleText = Me.Caption
    For i = 1 To ListView1.ListItems.Count
        .mschart1.Column = i
        .mschart1.ColumnLabel = ListView1.ListItems(i).Text
        .mschart1.Data = Val(ListView1.ListItems(i).SubItems(1))
    Next i

        .Show
   End With
    Else
        MsgBox "在此查询方式下不能查看统计图", vbOKOnly + vbInformation, "提示"
        
    End If
Case 0 '查询
 
    If Combo1.Text = "(全部)" Then
        xzstr = "*"
    Else
        xzstr = Combo1.Text
    End If
    If Check1.Value = 1 Then
        sqlstr = "select 介绍人,sum(收入) as 收入0 from 收入表 where 日期>=#" & DTPicker1(0).Value & "# and 日期<=#" & DTPicker1(1).Value & "# group by 介绍人"
        'sqlstr1 = "select count(*) from 收入表 where 日期>=#" & DTPicker1(0).Value & "# and 日期<=#" & DTPicker1(1).Value & "# group by 介绍人"
        
    Else
        sqlstr = "select 日期,卡号,项目,介绍人,客人姓名,收入 as 收入0,支付方式,备注 from 收入表 where 介绍人 like '" + xzstr + "' and 日期>=#" & DTPicker1(0).Value & "# and 日期<=#" & DTPicker1(1).Value & "#"
        'sqlstr1 = "select count(*) from 收入表 where 介绍人 like '" + xzstr + "' and 日期>=#" & DTPicker1(0).Value & "# and 日期<=#" & DTPicker1(1).Value & "#"
         End If
   Me.MousePointer = 11

    Set rec = db.OpenRecordset(sqlstr)
  If rec.EOF And rec.BOF Then
    jrsn = 0
  Else
    rec.MoveLast
    rec.MoveFirst
    jrsn = rec.RecordCount
  End If
   ProgressBar1.Visible = True
   
   zje = 0
    Set rec = db.OpenRecordset(sqlstr)
    ListView1.ListItems.Clear
    Do While Not rec.EOF
        Set itmx = ListView1.ListItems.Add(, , Format(rec.Fields(0), "yyyy-mm-dd"))
        For i = 1 To rec.Fields.Count - 1
                       
                itmx.SubItems(i) = IIf(IsNull(rec.Fields(i)), "", rec.Fields(i))
            
        Next i
        zje = zje + rec.Fields("收入0")
        ProgressBar1.Value = (rec.AbsolutePosition + 1) / jrsn * 100
        rec.MoveNext
    Loop
    
    ProgressBar1.Visible = False
    Me.MousePointer = 0
    If ListView1.ListItems.Count = 0 Then
        Command1(1).Enabled = False
          Command1(2).Enabled = False
        MsgBox "没有您要查找的记录", vbOKOnly + vbInformation, "提示"
        
    Else
        Command1(1).Enabled = True
        If Check1.Value = 0 Then
          Command1(2).Enabled = True
          Else
          Command1(2).Enabled = False
          End If
          ListView1.SortKey = 0
        ListView1.SortOrder = lvwAscending
        ListView1.Sorted = True
    End If
    Label2 = "总共查找到： " & jrsn & " 条                             收入总金额： " & Format(zje, "###,###,###.00") & " ￥"

Case 1 '打印
            yw_nr = Label2.Caption
            SaveSetting "奇迹公司", "页眉/页尾", "页尾打印", "1"
            dytr_main Me, 1, Me.Caption, "介绍人总计表"

Case 2 '删除
    If ListView1.ListItems.Count = 0 Then
    MsgBox "没有记录供您删除", vbOKOnly + vbCritical, "错误"
    Exit Sub
 End If
 If MsgBox("真的想删除列表中的记录吗？", vbYesNo + vbQuestion + vbDefaultButton2, "提示") = vbNo Then
    Exit Sub
 End If

 sqlstr = Right(sqlstr, Len(sqlstr) - 6)
 sqlstr = "delete" + sqlstr
 db.Execute sqlstr
 ListView1.ListItems.Clear
Command1(1).Enabled = False
Command1(2).Enabled = False
Case 3 '退出
    Unload Me
End Select
Exit Sub
jgqerr:
    MsgBox Err.Description, vbOKOnly + vbCritical, "错误"

End Sub

Private Sub Form_Load()
    frmcen Me
    frm_main.jsryzj.Enabled = False
    DTPicker1(0).Value = Date - 30
    DTPicker1(1).Value = Date
    Combo1.AddItem "(全部)"
    sqlstr = "select distinct 介绍人 from 收入表"
    Set rec = db.OpenRecordset(sqlstr)
    Do While Not rec.EOF
        Combo1.AddItem rec.Fields(0)
        rec.MoveNext
    Loop
    If Combo1.ListCount <> 0 Then
        Combo1.ListIndex = 0
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    frm_main.jsryzj.Enabled = True

End Sub

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
ListView1.SortKey = ColumnHeader.Index - 1
yn = MsgBox("将按照『" + ColumnHeader.Text + "』排序" + Chr(13) + "是否按升序排列,按[否]将按降序排列", vbYesNo + vbQuestion, "提示")
If yn = vbNo Then
    ListView1.SortOrder = lvwDescending
Else
    ListView1.SortOrder = lvwAscending
End If
ListView1.Sorted = True

End Sub