frm_dcczgl.frm

美容院管理系统

    Frame4.Visible = True
Else
    Frame4.Visible = False
End If
End Sub

Private Sub Combo1_Click()
sqlstr = "select DISTINCT 项目 from 单次处置表 where 类别='" + Combo1.Text + "'"
Set sqlrec = db.OpenRecordset(sqlstr)
List1.Clear
Do While Not sqlrec.EOF
    List1.AddItem sqlrec.Fields("项目")
    sqlrec.MoveNext
Loop
If List1.ListCount = 0 Then
   For i = 0 To 5
        Command1(i).Enabled = False
   Next i
   Command1(0).Enabled = True
   Command1(5).Enabled = True
   
   List2.Clear
Else
    List1.ListIndex = 0
     For i = 0 To 5
        Command1(i).Enabled = True
   Next i
     
End If
End Sub

Private Sub Command1_Click(Index As Integer)
On Error GoTo jgqerr
Select Case Index
Case 0 '开新单

'Me.Hide
Load frm_dcczdj
frm_dcczdj.Show 1
Case 1 '删除
    PopupMenu frm_main.xm
Case 2 '查询
enab
Text2(0).SetFocus
Case 3 '打印
For k = 0 To 2
    Printer.ScaleMode = 1
    Printer.FontItalic = False
    
For Each lab In Label1
    Printer.ForeColor = lab.ForeColor
    Printer.CurrentX = lab.Left
    Printer.CurrentY = lab.Top + k * Frame1.Height
    Printer.FontName = lab.FontName
    Printer.FontSize = lab.FontSize
    Printer.FontBold = lab.FontBold
    Printer.FontUnderline = lab.FontUnderline
    If lab.Caption = "单次处置记帐凭证" Then
       Select Case k
       Case 0
           Printer.Print "单次处置记帐凭证"
       Case 1
           Printer.Print "单次处置信誉卡"
       Case 2
           Printer.Print "单次处置通知单"
       End Select
    Else
       Printer.Print lab.Caption
    End If
Next lab
For Each lab In Label3
    Printer.ForeColor = lab.ForeColor
    Printer.CurrentX = lab.Left
    Printer.CurrentY = lab.Top + k * Frame1.Height
    Printer.FontName = lab.FontName
    Printer.FontSize = lab.FontSize
    Printer.FontBold = lab.FontBold
    Printer.FontUnderline = lab.FontUnderline
    Printer.Print lab.Caption
Next lab
Printer.DrawWidth = 1
For Each lab In Line1 '表格
        Printer.Line (lab.X1, lab.Y1 + k * Frame1.Height)-(lab.X2, lab.Y2 + k * Frame1.Height), vbBlack
Next lab
For Each lab In Line2 '表格
        Printer.Line (lab.X1, lab.Y1 + k * Frame1.Height)-(lab.X2, lab.Y2 + k * Frame1.Height), vbBlack
Next lab
Next k
Printer.EndDoc

Case 4 '原料支配
If Left(Label3(9), 2) = "单次" Then
    If Label3(11) = "否" Then
        ttt = False
        sqlstr = "select 所需原料 from 项目收费表 where 项目='" + Label3(5) + "'"
        Set sqlrec = db.OpenRecordset(sqlstr)
        If sqlrec.EOF And sqlrec.BOF Then
        Else
            frm_ylzp.Combo1 = "" & sqlrec.Fields(0)
        End If
        Load frm_ylzp
        frm_ylzp.Caption = frm_ylzp.Caption + "--" + Me.Caption
        frm_ylzp.Show 1
    Else
        MsgBox "该单次处置已经进行原料支配了", vbOKOnly + vbCritical, "提示"
    End If
Else
    MsgBox "该类型的单次处置不能进行原料支配", vbOKOnly + vbCritical, "提示"
End If
Case 5 '退出
    Unload Me
Case 6 '退货
    If MsgBox("真的要想退货吗？", vbYesNo + vbInformation + vbDefaultButton2, "提示") = vbNo Then
    Exit Sub
End If
If Label3(10) = "已退货" Then
    MsgBox "该客户已经退货，不能再退货", vbOKOnly + vbCritical, "错误"
    Exit Sub
End If
    
ttt:        fyp = InputBox("请输入退货的金额（￥）：", "退货")
        If IsNumeric(fyp) = False Then
            yn = MsgBox("您输入的退货金额有误，要重新输入吗？", vbYesNo + vbInformation, "提示")
            If yn = vbYes Then
                GoTo ttt
            End If
            Exit Sub
        End If
        If Val(fyp) > Val(Label3(6)) Then
            yn = MsgBox("您输入的退货金额超过了原金额", vbOKOnly + vbCritical, "错误")
            Exit Sub
        End If
    
        sqlrec.Edit
            sqlrec.Fields("备注") = "已退货"
        sqlrec.Update
        Label3(10) = "已退货"
        Set sqlrec = db.OpenRecordset("收入表")
        sqlrec.AddNew
            sqlrec.Fields("日期") = Date
            sqlrec.Fields("卡号") = Null
            sqlrec.Fields("项目") = Label3(5)
            Set rec = db.OpenRecordset("收入表", dbOpenDynaset)
            findstr = "日期=#" & CDate(Label3(0)) & "# and 项目='" + Label3(5) + "' and 收入=" + Label3(6) + " and 客人姓名='" + Label3(2) + "'"
            
            rec.FindFirst findstr
            
            sqlrec.Fields("介绍人") = rec.Fields("介绍人")
            sqlrec.Fields("客人姓名") = Label3(2)
            sqlrec.Fields("收入") = -Abs(Val(fyp))
            sqlrec.Fields("支付方式") = "现金"
            sqlrec.Fields("备注") = "退货"
        sqlrec.Update
        MsgBox "退卡成功", vbOKOnly + vbInformation, "提示"

Case 7 '确定
If Check2.Value Then
    If Trim(Text2(0)) = "" Then
        sqlstr = "select * from 单次处置表 where 姓名 like '*" + Trim(Text2(1)) + "*' and 项目 like '*" + Trim(Text2(2)) + "*' and 日期>=#" & DTPicker1(0).Value & "# and 日期<=#" & DTPicker1(1).Value & "#"
    Else
        sqlstr = "select * from 单次处置表 where 姓名 like '*" + Trim(Text2(1)) + "*' and 项目 like '*" + Trim(Text2(2)) + "*' and 日期>=#" & DTPicker1(0).Value & "# and 日期<=#" & DTPicker1(1).Value & "# and 编号='" + Trim(Text2(0)) + "'"
    End If
    
Else
    If Trim(Text2(0)) = "" Then
        sqlstr = "select * from 单次处置表 where 姓名 like '*" + Trim(Text2(1)) + "*' and 项目 like '*" + Trim(Text2(2)) + "*'"
    Else
        sqlstr = "select * from 单次处置表 where 姓名 like '*" + Trim(Text2(1)) + "*' and 项目 like '*" + Trim(Text2(2)) + "*' and 编号='" + Trim(Text2(0)) + "'"
    End If
End If
Set sqlrec = db.OpenRecordset(sqlstr)
If sqlrec.EOF And sqlrec.BOF Then
    yn = MsgBox("没有您要查找的记录，还要继续查找吗？", vbYesNo + vbInformation, "提示")
    If yn = vbNo Then
        disa
    Else
        Text2(0).SetFocus
    End If
Else
   sqlrec.MoveLast
   sqlrec.MoveFirst
   If sqlrec.RecordCount = 1 Then
   Else
      MsgBox "查到您要找的记录 " & sqlrec.RecordCount & " 条，下面只能列出第一条" + Chr(13) + "您可以重设查询条件再查找", vbOKOnly + vbInformation, "提示"
   End If
    disa
      tr
      For i = 0 To Combo1.ListCount - 1
            If Combo1.List(i) = Label3(9) Then
                Combo1.ListIndex = i
                Exit For
            End If
      Next i
      For i = 0 To List1.ListCount - 1
                If List1.List(i) = Label3(5) Then
                List1.ListIndex = i
                Exit For
            End If
      Next i
      For i = 0 To List2.ListCount - 1
                If Left(List2.List(i), 7) = Label3(1) Then
                List2.ListIndex = i
                Exit For
            End If
      Next i
      
End If

Case 8 '取消
disa
End Select
Exit Sub
jgqerr:
    MsgBox Err.Description, vbOKOnly + vbCritical, "错误"

End Sub

Private Sub Form_Load()
frmcen Me
frm_main.dccz.Enabled = False
'frm_main.Toolbar2.Buttons(5).Enabled = False

DTPicker1(0).Value = Date - 30
DTPicker1(1).Value = Date

For i = 0 To Label3.Count - 1
    Label3(i) = ""
Next i
ss
disa

End Sub

Public Sub ss()
sqlstr = "select DISTINCT 类别 from 单次处置表"
Set sqlrec = db.OpenRecordset(sqlstr)
Combo1.Clear
Do While Not sqlrec.EOF
    Combo1.AddItem sqlrec.Fields("类别")
    sqlrec.MoveNext
Loop
If Combo1.ListCount = 0 Then
   For i = 0 To 6
        Command1(i).Enabled = False
   Next i
   Command1(0).Enabled = True
   Command1(5).Enabled = True
   
   List1.Clear
   List2.Clear
   For i = 0 To Label3.Count - 1
        Label3(i) = ""
   Next i
Else
    Combo1.ListIndex = 0
     For i = 0 To 6
        Command1(i).Enabled = True
   Next i
     
End If
End Sub
Private Sub disa()
Frame3.Visible = False
Frame1.Visible = True
Combo1.Enabled = True
List1.Enabled = True
List2.Enabled = True
Picture1.Visible = True
Picture2.Visible = False
Command1(0).Default = True
Command1(5).Cancel = True
End Sub
Private Sub enab()
Command1(7).Default = True
Command1(8).Cancel = True
Frame3.Visible = True
Frame1.Visible = False
Combo1.Enabled = False
List1.Enabled = False
List2.Enabled = False
Picture1.Visible = False
Picture2.Visible = True

End Sub

Private Sub Form_Unload(Cancel As Integer)
SaveSetting App.title, "Options", "mfxj_maxno", mfxj_maxno
SaveSetting App.title, "Options", "mfsj_maxno", mfsj_maxno
SaveSetting App.title, "Options", "lygxj_maxno", lygxj_maxno
SaveSetting App.title, "Options", "hzpxj_maxno", hzpxj_maxno
SaveSetting App.title, "Options", "hzpsj_maxno", hzpsj_maxno
SaveSetting App.title, "Options", "dcxj_maxno", dcxj_maxno
SaveSetting App.title, "Options", "dcsj_maxno", dcsj_maxno
frm_main.dccz.Enabled = True
'frm_main.Toolbar2.Buttons(5).Enabled = True
'db.Close
'Set db = Nothing
End Sub

Private Sub List1_Click()
sqlstr = "select * from 单次处置表 where 类别='" + Combo1.Text + "' and 项目='" + List1.Text + "'"
Set sqlrec = db.OpenRecordset(sqlstr)
List2.Clear
Do While Not sqlrec.EOF
    List2.AddItem sqlrec.Fields("编号") + "-" + sqlrec.Fields("姓名")
    sqlrec.MoveNext
Loop
If List2.ListCount = 0 Then
   For i = 0 To 5
        Command1(i).Enabled = False
   Next i
   Command1(0).Enabled = True
   Command1(5).Enabled = True
   
   
Else
    List2.ListIndex = 0
     For i = 0 To 5
        Command1(i).Enabled = True
   Next i
     
End If
End Sub

Private Sub List2_Click()
sqlstr = "select * from 单次处置表 where 类别='" + Combo1.Text + "' and 项目='" + List1.Text + "' and 编号='" + Left(List2.Text, 7) + "'"
Set sqlrec = db.OpenRecordset(sqlstr)


    
If sqlrec.EOF And sqlrec.BOF Then
   For i = 0 To 5
        Command1(i).Enabled = False
   Next i
   Command1(0).Enabled = True
   Command1(5).Enabled = True
   
   
Else
   tr
     For i = 0 To 5
        Command1(i).Enabled = True
   Next i
     
End If

End Sub

Private Sub tr()
 Label3(0) = Format(sqlrec.Fields("日期"), "yyyy-mm-dd")
 
    For i = 1 To sqlrec.Fields.Count - 1
        
        Label3(i) = sqlrec.Fields(i)
    Next i
 If Left(sqlrec.Fields("类别"), 2) = "单次" Then
    Label3(11).Visible = True
    Label1(11).Visible = True
 Else
    Label3(11).Visible = False
    Label1(11).Visible = False
 End If
End Sub

Private Sub qbdc_Click()
 yn = MsgBox("真的想全部删除单次记录吗？", vbYesNo + vbInformation + vbDefaultButton2, "提示")
    If yn = vbNo Then
        Exit Sub
    End If
    sqlstr = "delete * from 单次处置表"
    db.Execute sqlstr
        dcsj_maxno = "0"
        dcxj_maxno = "0"
        hzpsj_maxno = "0"
        hzpxj_maxno = "0"
        mfsj_maxno = "0"
        mfxj_maxno = "0"
        lygxj_maxno = "0"
    
    
    ss
    
End Sub