query.frm

订餐的一个软件 ,美食档案 订餐点菜 销量查询 用于各级酒店餐饮部门的订餐点菜及收费管理

      .Text = "日期无效！"
      .SetFocus
      .SelStart = 0
      .SelLength = Len(.Text)
      Exit Sub
    End If
  End With
  With txtDate2
    If Not IsDate(.Text) Then
      .Text = "日期无效！"
      .SetFocus
      .SelStart = 0
      .SelLength = Len(.Text)
      Exit Sub
    End If
  End With
  txtDate1 = Format(txtDate1, "YYYY-MM-DD")
  txtDate2 = Format(txtDate2, "YYYY-MM-DD")
  strDate = " And DinnerDate Between #" & txtDate1 & "# And #" & txtDate2 & "#"
  
End If
  
Dim strItem() As String
Dim dblCount() As Double
Dim dblTotal() As Double
  
Dim lngSumCount As Long
Dim curSumTotal As Currency
Dim I As Long, J As Long
Rec.Close
Set Rec = Nothing
Set Rec = DB.OpenRecordset("Select Top 9999 MenuName, Sum(TotalCount), Sum(Total) From Account Where Checked = 1" & strDate & " Group By MenuName Order By MenuName")
If Rec.RecordCount > 0 Then
  Rec.MoveFirst
  Do Until Rec.EOF
    ReDim Preserve strItem(I) As String
    ReDim Preserve dblCount(I) As Double
    ReDim Preserve dblTotal(I) As Double
    dblCount(I) = Rec.Fields(1)
    lngSumCount = lngSumCount + dblCount(I)
    dblTotal(I) = Rec.Fields(2)
    curSumTotal = curSumTotal + dblTotal(I)
    strItem(I) = Rec.Fields(0) & Space(20 - LenB(StrConv(Rec.Fields(0), vbFromUnicode))) _
                 & Space(3) & dblCount(I) & Space(8 - Len(Str(dblCount(I)))) & Space(12 - Len(Format(dblTotal(I), "##0.00"))) & Format(dblTotal(I), "##0.00")
    Rec.MoveNext
    I = I + 1
  Loop
  DataSort dblCount(), strItem(), dblTotal()
  List1.Clear
  For J = 0 To I - 1
    List1.AddItem Format(J + 1, "0000") & Space(3) & strItem(J)
  Next J
  DataSort dblTotal(), strItem(), dblCount()
  List2.Clear
  For J = 0 To I - 1
    List2.AddItem Format(J + 1, "0000") & Space(3) & strItem(J)
  Next J
End If

optSaleMoney.Value = True
optSaleCount.Value = True

lblTotal = "合计：" & I & "种，" & lngSumCount & "份，" & "销售额(含让利部分)：" & Format(curSumTotal, "##0.00") & "元"

End Sub


Private Sub cmdYearFind_Click()
Dim datFind As Date
Dim strFind As String
strFind = Trim(InputBox("请输入2位或4位年份：(如：" & Format(Date, "YYYY") & "或" & Format(Date, "YY") & "代表" & Format(Date, "YYYY") & "年)", "年销售额查询", Format(Date, "YYYY")))
If strFind = "" Then Exit Sub
Dim strDate As String
strDate = Left(strFind & "-01-01", 10)
If Not IsDate(strDate) Then
  MsgBox "“" & strFind & "”不是一个有效的年份！", vbInformation, "年销售额查询"
  Exit Sub
End If
datFind = CDate(strDate)
If MsgBox("您要查询的年份是" & Year(datFind) & "年吗？", vbQuestion + vbYesNo, "年销售额查询") = vbNo Then
  Exit Sub
End If
Dim Rec As Recordset
Dim S As Currency
Set Rec = DB.OpenRecordset("Select Sum(Pay) From Sale Where Year(Date) = " & Year(datFind))
If Not IsNull(Rec.Fields(0)) Then
  S = Rec.Fields(0)
End If
MsgBox Year(datFind) & "年的销售额是：" & Format(S, "##0.00") & "元。", vbInformation, "年销售额查询"
Rec.Close
Set Rec = Nothing

End Sub

Private Sub Form_Load()
sngChartHeight = lblChart(0).Height
sngChartTop = lblChart(0).Top
Set DB = OpenDatabase(AppDir & "Menu.mdb")
Set Rec = DB.OpenRecordset("Select * From Account Where Checked=1", dbOpenSnapshot)
If Rec.RecordCount = 0 Then
  MsgBox "无销售记录！", vbInformation, "销量查询"
  Timer1.Enabled = True
  Exit Sub
End If
txtDate1 = Format(Date, "YYYY-MM-DD")
txtDate2 = txtDate1
txtDay2 = txtDate1
txtDay1 = Format(DateSerial(Year(Date), Month(Date) - 1, Day(Date)), "YYYY-MM-DD")

cmdFindDay_Click
optWhole.Value = True

cmdOK_Click

ShowChart Date
Me.Show
frmMain.Hide

End Sub

Private Sub Form_Unload(Cancel As Integer)
Rec.Close
DB.Close
Set Rec = Nothing
Set DB = Nothing
frmMain.Show
End Sub



Private Sub Frame3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
lblSetMonth.ForeColor = &HFF8080
End Sub

Private Sub Frame4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
lblSetMonth.ForeColor = &HFF8080

End Sub

Private Sub lblSetMonth_Click()
Dim datFind As Date
Dim strFind As String
strFind = Trim(InputBox("请输入您要设置的最近年、月：(格式：YYYY-MM 如：" & Format(Date, "YYYY-MM") & ")", "设置最近月份", Format(Date, "YYYY-MM")))
If strFind = "" Then Exit Sub
If Not IsDate(Left(strFind, 7)) Then
  MsgBox "“" & strFind & "”不是一个有效的年月！", vbInformation, "设置最近月份"
  Exit Sub
End If
datFind = CDate(strFind)
If MsgBox("您要设置的最近年月是" & Year(datFind) & "年" & Month(datFind) & "月吗？", vbQuestion + vbYesNo, "设置最近月份") = vbNo Then
  Exit Sub
End If
ShowChart datFind
End Sub

Private Sub lblSetMonth_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
lblSetMonth.ForeColor = &HFFFF00
End Sub

Private Sub lstEveryDay_Click()
lstDay.Clear
Dim MyRec As Recordset
Dim strFind As String
Dim S As Currency
strFind = "Date = #" & Left(lstEveryDay.Text, 10) & "#"
Set MyRec = DB.OpenRecordset("Select CustomerID, Pay, Date From Sale Order By CustomerID", dbOpenSnapshot)
MyRec.FindFirst strFind
Do Until MyRec.NoMatch
  lstDay.AddItem MyRec.Fields(0) & Space(20 - LenB(StrConv(MyRec.Fields(0), vbFromUnicode))) _
                  & Space(15 - Len(Format(MyRec.Fields(1), "##0.00"))) & Format(MyRec.Fields(1), "##0.00")
  S = S + MyRec.Fields(1)
  MyRec.FindNext strFind
Loop
lblDay = "合计：共" & lstDay.ListCount & "组客人，消费额总计：" & Format(S, "##0.00") & "元"
lblTitle = "----- " & Left(lstEveryDay.Text, 10) & " 销售情况 -----"
MyRec.Close
Set MyRec = Nothing
End Sub

Private Sub optPart_Click()
  lstCompare.Clear
  List1.Clear: List2.Clear
  lblTotal = ""
  txtDate1.Visible = True
  txtDate2.Visible = True
  lblDate1.Visible = True
  lblDate2.Visible = True
  txtDate1.SetFocus
  txtDate1.SelStart = 0
  txtDate1.SelLength = Len(txtDate1)
End Sub

Private Sub optSaleCount_Click()
lstCompare.Clear
Dim I As Integer
For I = 0 To List1.ListCount - 1
  lstCompare.AddItem List1.List(I)
Next I
End Sub

Private Sub optSaleMoney_Click()
lstCompare.Clear
Dim I As Integer
For I = 0 To List2.ListCount - 1
  lstCompare.AddItem List2.List(I)
Next I
End Sub

Private Sub optWhole_Click()
    lstCompare.Clear
    List1.Clear: List2.Clear
    lblTotal = ""
  strDate = ""
  txtDate1.Visible = False
  txtDate2.Visible = False
  lblDate1.Visible = False
  lblDate2.Visible = False
End Sub

Private Sub Timer1_Timer()
Timer1.Enabled = False
Unload Me
End Sub


Private Sub DataSort(X() As Double, Y() As String, Z() As Double)
Dim I As Integer, J As Integer, N As Integer, M As Double, S As String, D As Double
N = UBound(X)
For I = 0 To N - 1
  For J = 0 To N - 1 - I
    If X(J) < X(J + 1) Then
      M = X(J)
      X(J) = X(J + 1)
      X(J + 1) = M
      S = Y(J)
      Y(J) = Y(J + 1)
      Y(J + 1) = S
      D = Z(J)
      Z(J) = Z(J + 1)
      Z(J + 1) = D
    End If
  Next J
Next I
End Sub


Private Sub txtDate1_Change()
lstCompare.Clear
List1.Clear: List2.Clear
lblTotal = ""
If txtDate1 <> "" And txtDate2 <> "" Then
  cmdOK.Enabled = True
Else
  cmdOK.Enabled = False
End If
End Sub

Private Sub txtDate2_Change()
lstCompare.Clear
List1.Clear: List2.Clear
lblTotal = ""
If txtDate1 <> "" And txtDate2 <> "" Then
  cmdOK.Enabled = True
Else
  cmdOK.Enabled = False
End If
End Sub

Private Sub txtDay1_Change()
lstEveryDay.Clear
lstDay.Clear
lblDay = ""
lblEveryDay = ""
lblTitle = ""
If txtDay1 = "" Or txtDay2 = "" Then
  cmdFindDay.Enabled = False
Else
  cmdFindDay.Enabled = True
End If
End Sub

Private Sub txtDay2_Change()
lstEveryDay.Clear
lstDay.Clear
lblDay = ""
lblEveryDay = ""
lblTitle = ""
If txtDay1 = "" Or txtDay2 = "" Then
  cmdFindDay.Enabled = False
Else
  cmdFindDay.Enabled = True
End If
End Sub

Private Function MaxSale(Count() As Currency, N As Integer) As Currency
Dim M As Currency
Dim I As Integer
M = Count(0)
For I = 1 To N
  If Count(I) > M Then
    M = Count(I)
  End If
Next I
MaxSale = M
End Function

Private Sub ShowChart(datMonth As Date)
Dim Rec As Recordset
Dim I As Integer
Dim datFind(7) As Date
Dim curS(7) As Currency, curMax As Currency
For I = 0 To 7
datFind(I) = DateSerial(Year(datMonth), Month(datMonth) - I, Day(datMonth))
Set Rec = DB.OpenRecordset("Select Sum(Pay) From Sale Where Year(Date) = " & Year(datFind(I)) & " And Month(Date) = " & Month(datFind(I)))
If Not IsNull(Rec.Fields(0)) Then
  curS(I) = Rec.Fields(0)
End If
Rec.Close
Set Rec = Nothing
Next I
curMax = MaxSale(curS(), 7)
If curMax = 0 Then curMax = 1
For I = 0 To 7
With lblChart(I)
  .Height = curS(I) / curMax * sngChartHeight
  .Top = sngChartTop + (sngChartHeight - .Height)
  .ToolTipText = Year(datFind(I)) & "年" & Month(datFind(I)) & "月销售额：" & Format(curS(I), "##0.00") & "元。"
End With
lblMonth(I) = Format(datFind(I), "YY-MM")
Next I
lblMoney = Format(curS(0), "##0.00")
lblMoney.Top = lblChart(0).Top - lblMoney.Height
End Sub