frm_mrszj.frm

美容院管理系统

            Text            =   "项目"
            Object.Width           =   2540
         EndProperty
         BeginProperty ColumnHeader(7) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            Alignment       =   1
            SubItemIndex    =   6
            Text            =   "金额(￥)"
            Object.Width           =   1764
         EndProperty
         BeginProperty ColumnHeader(8) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   7
            Text            =   "收款员"
            Object.Width           =   1764
         EndProperty
         BeginProperty ColumnHeader(9) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   8
            Text            =   "美容师"
            Object.Width           =   1764
         EndProperty
         BeginProperty ColumnHeader(10) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   9
            Text            =   "类别"
            Object.Width           =   2117
         EndProperty
         BeginProperty ColumnHeader(11) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   10
            Text            =   "备注"
            Object.Width           =   2540
         EndProperty
      End
      Begin VB.Label Label2 
         BackColor       =   &H00C0E0FF&
         BorderStyle     =   1  'Fixed Single
         Height          =   255
         Index           =   1
         Left            =   165
         TabIndex        =   19
         Top             =   2430
         Width           =   8445
      End
      Begin VB.Label Label2 
         BackColor       =   &H00C0E0FF&
         BorderStyle     =   1  'Fixed Single
         Height          =   255
         Index           =   0
         Left            =   165
         TabIndex        =   18
         Top             =   165
         Width           =   8430
      End
   End
End
Attribute VB_Name = "frm_mrszj"
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 sqlstr1 As String
Dim col As ColumnHeader

Private Sub OKButton_Click()

End Sub

Private Sub Check1_Click()

If Check1.Value = 1 Then
    Combo1.ListIndex = 0
    Combo1.Enabled = False
    Combo1.Enabled = False
    Command1(2).Enabled = False
    Frame4.Left = Frame3.Left
    Frame4.Top = Frame3.Top
    Frame3.Visible = False
    Frame4.Visible = True
    
Else
    Combo1.Enabled = True
    Frame4.Visible = False
    Frame3.Visible = True
    
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 ListView3.ListItems.Count <> 0 Then
With frm_graph
    .mschart1.ColumnCount = Combo1.ListCount - 1
    .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
    iii = 0
    For i = 1 To ListView3.ListItems.Count
        If ListView3.ListItems(i).Text = "总计" Then
            iii = iii + 1
            .mschart1.Column = iii
            .mschart1.ColumnLabel = ListView3.ListItems(i).SubItems(1)
            .mschart1.Data = Val(ListView3.ListItems(i).SubItems(3))
        End If
    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
        sqlstr1 = "select 美容师,sum(收入) as 收入0 from 单次处置表 where 日期>=#" & DTPicker1(0).Value & "# and 日期<=#" & DTPicker1(1).Value & "# group by 美容师"
        sqlstr = "select 美容师,sum(金额) as 金额0 from 包月明细卡 where 日期>=#" & DTPicker1(0).Value & "# and 日期<=#" & DTPicker1(1).Value & "# group by 美容师"
        
        
    Else
        sqlstr = "select 编号,次数,日期,美容师,项目,备注,类型,金额 from 包月明细卡 where 美容师 like '" + xzstr + "' and 日期>=#" & DTPicker1(0).Value & "# and 日期<=#" & DTPicker1(1).Value & "#"
        sqlstr1 = "select * 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
   'zjezje = 0
   zje = 0
    Set rec = db.OpenRecordset(sqlstr)
    ListView1.ListItems.Clear
    ListView3.ListItems.Clear
    Do While Not rec.EOF
          If Check1.Value = 0 Then '非分组
            Set itmx = ListView1.ListItems.Add(, , rec.Fields(0))
            For i = 1 To rec.Fields.Count - 1
          
                If i = 2 Then
                    itmx.SubItems(i) = IIf(IsNull(rec.Fields(i)), "", Format(rec.Fields(i), "yyyy-mm-dd"))
                Else
                    itmx.SubItems(i) = IIf(IsNull(rec.Fields(i)), "", rec.Fields(i))
                End If
            
            Next i
            zje = zje + rec.Fields("金额")
        Else '分组
                    
                    Set itmx = ListView3.ListItems.Add(, , "")
            For i = 1 To 2
          
                
                    itmx.SubItems(i) = IIf(IsNull(rec.Fields(i - 1)), "", rec.Fields(i - 1))
                
            
            Next i
            itmx.SubItems(3) = "包月卡"
            zje = zje + rec.Fields("金额0")
        End If
        ProgressBar1.Value = (rec.AbsolutePosition + 1) / jrsn * 100
        rec.MoveNext
    Loop
    
    ProgressBar1.Visible = False
    Me.MousePointer = 0
   If Check1.Value = 0 Then '非分组
          ListView1.SortKey = 0
        ListView1.SortOrder = lvwAscending
        ListView1.Sorted = True
   
        Label2(0) = "[包月卡]总共查找到： " & jrsn & " 条                             收入总金额： " & Format(zje, "###,###,###.00") & " ￥"
    Else '分组
    End If
    'zjezje = zjezje + zje
'单次处置表的登记
    Set rec = db.OpenRecordset(sqlstr1)
  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(sqlstr1)
    ListView2.ListItems.Clear
    Do While Not rec.EOF
        If Check1.Value = 0 Then '非分组
            Set itmx = ListView2.ListItems.Add(, , Format(rec.Fields(0), "yyyy-mm-dd"))
            For i = 1 To rec.Fields.Count - 2
                    itmx.SubItems(i) = IIf(IsNull(rec.Fields(i)), "", rec.Fields(i))
                
            
            Next i
                zje = zje + rec.Fields("收入")
        Else '分组
                    Set itmx = ListView3.ListItems.Add(, , "")
                    For i = 1 To 2
                            itmx.SubItems(i) = IIf(IsNull(rec.Fields(i - 1)), "", rec.Fields(i - 1))
                           
            Next i
            itmx.SubItems(3) = "单次处置"
            zje = zje + rec.Fields("收入0")
        End If
        ProgressBar1.Value = (rec.AbsolutePosition + 1) / jrsn * 100
        rec.MoveNext
    Loop
    
    ProgressBar1.Visible = False
    Me.MousePointer = 0
If Check1.Value = 0 Then
    If ListView2.ListItems.Count = 0 And 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
        End If
    Else
     Command1(2).Enabled = False
     If ListView3.ListItems.Count = 0 Then
        MsgBox "没有您要查找的记录", vbOKOnly + vbInformation, "提示"
     End If
End If
If Check1.Value = 0 Then
          ListView2.SortKey = 0
        ListView2.SortOrder = lvwAscending
        ListView2.Sorted = True
    
    Label2(1) = "[单次处置]总共查找到： " & jrsn & " 条                             收入总金额： " & Format(zje, "###,###,###.00") & " ￥"
Else
   If ListView3.ListItems.Count <> 0 Then
        ll = Combo1.ListCount - 2
        For j = 0 To ll
            jjj = 0
        For i = 1 To ListView3.ListItems.Count
            If Combo1.List(j + 1) = ListView3.ListItems(i).SubItems(1) Then
               jjj = jjj + Val(ListView3.ListItems(i).SubItems(2))
            End If
        Next i
         Set itmx = ListView3.ListItems.Add(, , "总计")
         itmx.SubItems(1) = Combo1.List(j + 1)
         itmx.SubItems(2) = ""
         itmx.SubItems(3) = jjj
        Next j
        ListView3.SortKey = 1
        ListView3.SortOrder = lvwAscending
        ListView3.Sorted = True
        For i = 1 To ListView3.ListItems.Count
            If ListView3.ListItems(i).Text <> "总计" Then
                ListView3.ListItems(i).SubItems(1) = ""
            End If
        Next i
    End If
End If
Case 1 '打印
     If Check1.Value = 0 Then '非分组
          yn = MsgBox("请选择打印的种类:[是]包月卡，[否]单次处置", vbYesNoCancel + vbQuestion, "提示")
             If yn = vbCancel Then
                Exit Sub
             
          End If
          If yn = vbYes Then
            yw_nr = Label2(0).Caption
            SaveSetting "奇迹公司", "页眉/页尾", "页尾打印", "1"
             dytr_main Me, 1, Me.Caption, Combo1.Text + "美容师包月卡总计表"
          Else
            yw_nr = Label2(1).Caption
            SaveSetting "奇迹公司", "页眉/页尾", "页尾打印", "1"
             dytr_main Me, 2, Me.Caption, Combo1.Text + "美容师单次处置总计表"
          End If
          
          
     Else '分组
       yw_nr = Label2(3).Caption
            SaveSetting "奇迹公司", "页眉/页尾", "页尾打印", "1"
         dytr_main Me, 3, Me.Caption, "美容师分组总计表"
     End If
           
Case 2 '删除
    If ListView1.ListItems.Count = 0 And ListView2.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
 sqlstr1 = Right(sqlstr1, Len(sqlstr1) - 6)
 sqlstr1 = "delete" + sqlstr1
 db.Execute sqlstr1
 
 ListView1.ListItems.Clear
 ListView2.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.mrsyzj.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
    sqlstr = "select distinct 美容师 from 单次处置表"
    Set rec = db.OpenRecordset(sqlstr)
    Do While Not rec.EOF
        n = Combo1.ListCount - 1
        nn = False
        For i = 0 To n
            If Combo1.List(i) = rec.Fields(0) Then
                    nn = True
                    Exit For
                End If
            
        Next i
        If nn Then
        Else
            If rec.Fields(0) <> "" Then
                 Combo1.AddItem rec.Fields(0)
            End If
        End If
        
        rec.MoveNext
    Loop
    If Combo1.ListCount <> 0 Then
        Combo1.ListIndex = 0
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
frm_main.mrsyzj.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

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

End Sub