量本利分析.frm

一个客车售票系统

 Data2.Recordset.MoveNext
 Loop
 For I = 1 To K - 1
   For J = 1 To K - I
    If cx(J) > cx(J + 1) Then
     Temp = cx(J): cx(J) = cx(J + 1): cx(J + 1) = Temp
    End If
   Next J
 Next I
For P = 1 To K
    A1(cx(P), 2) = Val(Text6(1)) + Val(Text6(2)) + Val(Text6(3)) _
                 + Val(Text6(4)) + Val(Text6(5)) + Rs(cx(P)) * Val(Text6(6)) _
                 + Sr(cx(P), 3) * Val(Text6(7)) + A1(cx(P), 1) * Val(Text6(8))
    Cb(cx(P), 1) = Rs(cx(P)) * Val(Text6(6))
    Cb(cx(P), 2) = Sr(cx(P), 3) * Val(Text6(7))
    Cb(cx(P), 3) = A1(cx(P), 1) * Val(Text6(8))
Next P
 '如已有当前记录则做删除追加
 Cxs = "[" + Cxtj1 + "]" + "=" + "'" + Datedata + "'"
    Select Case Text4(3)
      Case "第一组"
       Data3.RecordSource = "Select * from  C1  where" & Cxs
      Case "第二组"
       Data3.RecordSource = "Select * from  C2  where" & Cxs
      Case "第三组"
       Data3.RecordSource = "Select * from  C3  where" & Cxs
      Case "第四组"
       Data3.RecordSource = "Select * from  C4  where" & Cxs
      Case "第五组"
       Data3.RecordSource = "Select * from  C5  where" & Cxs
      Case "第六组"
       Data3.RecordSource = "Select * from  C6  where" & Cxs
      Case "第七组"
       Data3.RecordSource = "Select * from  C7  where" & Cxs
      Case "第八组"
       Data3.RecordSource = "Select * from  C8  where" & Cxs
   End Select
   Data3.Refresh
   If Text3(1) <> " " Then
     Do While Data3.Recordset.EOF = False
     Data3.Recordset.Delete
     Data3.Recordset.MoveNext
     Loop
    Data3.Recordset.AddNew
    For P = 1 To K
   Text3(1) = Datedata: Text3(2) = cx(P): Text3(3) = A1(cx(P), 2)
   Data3.Recordset.AddNew
   Next P
Else
     Select Case Text4(3)
      Case "第一组"
       Data3.RecordSource = "C1"
      Case "第二组"
       Data3.RecordSource = "C2"
      Case "第三组"
       Data3.RecordSource = "C3"
      Case "第四组"
       Data3.RecordSource = "C4"
      Case "第五组"
       Data3.RecordSource = "C5"
      Case "第六组"
       Data3.RecordSource = "C6"
      Case "第七组"
       Data3.RecordSource = "C7"
      Case "第八组"
       Data3.RecordSource = "C8"
   End Select
 Data3.Refresh
    Data3.Recordset.AddNew
For P = 1 To K
   Text3(1) = Datedata: Text3(2) = cx(P): Text3(3) = A1(cx(P), 2)
    Data3.Recordset.AddNew
 Next P
End If
P = 1
Call ShowData
Exit Sub
A1:
  MsgBox "    日期不对，请重新选择统计的起始日期    ！     ", vbExclamation, "提示信息"
  Close #1
  Unload Me
End Sub
Private Sub Command1_Click()
Call Prn
End Sub
Private Sub Command2_Click()
Call TotalData
End Sub
Private Sub Command3_Click()
P = P - 1
If P < 1 Then
 P = Kp
End If
Call ShowData
End Sub
Private Sub Command4_Click()
P = P + 1
If P > Kp Then
  P = 1
End If
Call ShowData
End Sub
Private Sub Command5_Click()
On Error Resume Next
Unload Me
End Sub
Private Sub ShowData()
Dim Lr As Single
 Label40 = "车厢：" + CStr(cx(P))
 Label41 = "班组：" + Text4(3)
 Label42 = "发车日期：" + Datedata
 Label20 = "车次：" + CC
'单车量本利分析表
 Label9 = A1(cx(P), 1)
 Label10 = Format(A1(cx(P), 2), "0")
' Lr =
 Label11 = Format(A1(cx(P), 1) - A1(cx(P), 2), "0")
Select Case cx(P)
   Case 3, 4, 5, 6, 7, 8, 9
      Label12 = Text5(2)
      Label13 = Format(((A1(cx(P), 1) - A1(cx(P), 2) - Val(Text5(2))) * Val(Text5(4))), "0")
   Case 10
      Label12 = Text5(1)
      Label13 = Format(((A1(cx(P), 1) - A1(cx(P), 2) - Val(Text5(1))) * Val(Text5(4))), "0")
   Case Else
    Label12 = Text5(3)
    Label13 = Format(((A1(cx(P), 1) - A1(cx(P), 2) - Val(Text5(3))) * Val(Text5(4))), "0")
End Select
'单车收入表
Label17 = Sr(cx(P), 1)
Label18 = Sr(cx(P), 2)
Label19 = A1(cx(P), 1)
'单车成本表
Label30 = Text6(1)
Label31 = Text6(2)
Label32 = Text6(3)
Label33 = Text6(4)
Label34 = Text6(5)
'车站服务费 = 站售人数 × 系数
Label35 = Rs(cx(P)) * Val(Text6(6))
'代售票服务费= 外局售票收入× 系数
Label36 = Sr(cx(P), 3) * Val(Text6(7))
'营业外附加费 = 全部收入 × 系数
Label37 = A1(cx(P), 1) * Val(Text6(8))
Label38 = Format(A1(cx(P), 2), "0")
End Sub
Private Sub TotalData()
Dim Ta1 As Currency, Ta2 As Currency, Ta3 As Currency
Dim Tb1 As Currency, Tb2 As Currency
Dim Tc1 As Single, Tc2 As Single, Tc3 As Single
Dim Tc4 As Single, Tc5 As Single, Tc6 As Single
Dim Tc7 As Single, Tc8 As Single, Tc9 As Currency
 Label40 = "车厢： 全车"
For P = 1 To K
Ta1 = Ta1 + A1(cx(P), 1): Ta2 = Ta2 + A1(cx(P), 2)
Select Case cx(P)
  Case 3, 4, 5, 6, 7, 8, 9
   Ta3 = Ta3 + Text5(2)
  Case 10
   Ta3 = Ta3 + Text5(1)
  Case Else
   Ta3 = Ta3 + Text5(3)
End Select
Tb1 = Tb1 + Sr(cx(P), 1): Tb2 = Tb2 + Sr(cx(P), 2)
Tc1 = Tc1 + Val(Text6(1)): Tc2 = Tc2 + Val(Text6(2)): Tc3 = Tc3 + Val(Text6(3))
Tc4 = Tc4 + Val(Text6(4)): Tc5 = Tc5 + Val(Text6(5)): Tc6 = Tc6 + Rs(cx(P)) * Val(Text6(6))
Tc7 = Tc7 + Sr(cx(P), 3) * Val(Text6(7)): Tc8 = Tc8 + A1(cx(P), 1) * Val(Text6(8))
Next
Tc9 = Tc1 + Tc2 + Tc1 + Tc3 + Tc4 + Tc5 + Tc6 + Tc7 + Tc8
'单车量本利分析表
 Label9 = Int(Ta1)
 Label10 = Int(Ta2)
 Label11 = Int(Ta1 - Ta2)
 Label12 = Int(Ta3)
'单车收入表
Label17 = Int(Tb1)
Label18 = Int(Tb2)
Label19 = Int(Tb1 + Tb2)
'单车成本表
Label30 = Int(Tc1)
Label31 = Int(Tc2)
Label32 = Int(Tc3)
Label33 = Int(Tc4)
Label34 = Int(Tc5)
Label35 = Int(Tc6)
Label36 = Int(Tc7)
Label37 = Int(Tc8)
Label38 = Int(Tc9)
End Sub
Private Sub Prn()
Dim X1 As Single, Dx As Single
Dim Y1 As Single, Dy As Single
Dim Y2 As Single
On Error GoTo P1
Printer.Orientation = 1
Printer.PaperSize = 9
Printer.ScaleMode = 7
For P = 4 To 4
Printer.CurrentX = 3.35
Printer.CurrentY = 3.8
Printer.FontSize = 10
Printer.Print "车厢：" + CStr(cx(P))
Printer.CurrentX = 7
Printer.CurrentY = 3.8
Printer.Print "班组：" + Text4(3)
Printer.CurrentX = 12
Printer.CurrentY = 3.8
Printer.Print "发车日期：" + Datedata
'打印单车量本利分析表
Printer.CurrentX = 7
Printer.CurrentY = 2.3
Printer.FontSize = 20
Printer.Print "单车量本利分析表"
Y1 = 4.5: Dy = 2.3
Printer.Line (2.5, Y1)-(17.5, Y1 + Dy), , B
Printer.Line (2.5, Y1 + 0.9)-(17.5, Y1 + 0.9)
X1 = 5.5: Dx = 3
Y2 = Y1 + Dy
For I = 1 To 4
Printer.Line (X1, Y1)-(X1, Y2)
 X1 = X1 + Dx
Next I
Y1 = Y1 + 0.2
Printer.FontSize = 10
Printer.CurrentX = 3.35
Printer.CurrentY = Y1
Printer.Print "收   入"
Printer.CurrentX = 6.4
Printer.CurrentY = Y1
Printer.Print "成   本"
Printer.CurrentX = 9.4
Printer.CurrentY = Y1
Printer.Print "利   润"
Printer.CurrentX = 12.4
Printer.CurrentY = Y1
Printer.Print "利润基数"
Printer.CurrentX = 15.4
Printer.CurrentY = Y1
Printer.Print "增减工资"

Y1 = 5.7

Printer.CurrentX = 3.35
Printer.CurrentY = Y1
Printer.Print Right(A1(cx(P), 1), 9, 2)
Printer.CurrentX = 6.4
Printer.CurrentY = Y1
Printer.Print Right(A1(cx(P), 2), 9, 2)
Printer.CurrentX = 9.4
Printer.CurrentY = Y1
Printer.Print Right((A1(cx(P), 1) - A1(cx(P), 2)), 9, 2)
Printer.CurrentX = 12.4
Printer.CurrentY = Y1
Select Case cx(P)
   Case 3, 4, 5, 6, 7, 8, 9
    Printer.Print Right(Val(Text5(2)), 9, 2)
   Case 10
    Printer.Print Right(Val(Text5(1)), 9, 2)
   Case Else
    Printer.Print Right(Val(Text5(3)), 9, 2)
End Select
Printer.CurrentX = 15.4
Printer.CurrentY = Y1
Select Case cx(P)
   Case 3, 4, 5, 6, 7, 8, 9
    Printer.Print Right(((A1(cx(P), 1) - A1(cx(P), 2) - Val(Text5(2))) * Val(Text5(4))), 9, 2)
   Case 10
    Printer.Print Right(((A1(cx(P), 1) - A1(cx(P), 2) - Val(Text5(1))) * Val(Text5(4))), 9, 2)
   Case Else
    Printer.Print Right(((A1(cx(P), 1) - A1(cx(P), 2) - Val(Text5(3))) * Val(Text5(4))), 9, 2)
End Select


'打印单车收入表
Printer.FontSize = 20
Printer.CurrentX = 8
Printer.CurrentY = 8.3
Printer.Print "单车收入表"
X1 = 2.5: Dx = 3
Y1 = 9.5: Dy = 1.8
Y2 = Y1 + Dy
Printer.Line (X1, Y1)-(17.5, Y1 + Dy), , B
Printer.Line (X1, Y1 + Dy / 2)-(17.5, Y1 + Dy / 2)
Printer.Line (X1 + 4, Y1)-(X1 + 4, Y2)
Printer.Line (X1 + 8, Y1)-(X1 + 8, Y2)
Printer.FontSize = 10
Printer.CurrentX = X1 + 1.3
Printer.CurrentY = Y1 + 0.3
Printer.Print "票价收入"
Printer.CurrentX = X1 + 5.2
Printer.CurrentY = Y1 + 0.3
Printer.Print "车补收入"
Printer.CurrentX = X1 + 10.1
Printer.CurrentY = Y1 + 0.3
Printer.Print "合     计"

Printer.CurrentX = X1 + 1.5
Printer.CurrentY = Y1 + 1.2
Printer.Print Right(Sr(cx(P), 1), 9, 2)

Printer.CurrentX = X1 + 5.5
Printer.CurrentY = Y1 + 1.2
Printer.Print Right(Sr(cx(P), 2), 9, 2)

Printer.CurrentX = X1 + 10
Printer.CurrentY = Y1 + 1.2
Printer.Print Right(A1(cx(P), 1), 9, 2)
Printer.CurrentX = 12
Printer.CurrentY = 26.5
Printer.Print "打印日期： " & Format(Date, "yyyy 年 m 月 d 日")


'打印单车成本表

Y1 = 14.5
Printer.FontSize = 20
Printer.CurrentX = 8
Printer.CurrentY = Y1
Printer.Print "单车成本表"
X1 = 2: Dx = 3
Y1 = 14: Dy = 1.8
Y2 = Y1 + Dy
Printer.Line (X1, Y1 + 2)-(17.8, Y1 + 7), , B
Printer.Line (X1 + 2, Y1 + 2.9)-(16, Y1 + 2.9)
Printer.Line (X1, Y1 + 4)-(17.8, Y1 + 4)
Printer.Line (4, Y1 + 2)-(4, Y1 + 7)
Printer.Line (16, Y1 + 2)-(16, Y1 + 7)

X1 = 6: Dx = 1.7
For I = 1 To 6
Printer.Line (X1, Y1 + 2.9)-(X1, Y1 + 7)
  X1 = X1 + Dx
Next I
X1 = 2: Y1 = 16
Printer.FontSize = 10
Printer.CurrentX = 2.4
Printer.CurrentY = Y1 + 0.7
Printer.Print "固定成本"
Printer.CurrentX = 9.2
Printer.CurrentY = Y1 + 0.3
Printer.Print "变动成本"
Printer.CurrentX = 4.4
Printer.CurrentY = Y1 + 1
Printer.Print "机  车"
Printer.CurrentX = 4.4
Printer.CurrentY = Y1 + 1.5
Printer.Print "牵引费"
Printer.CurrentX = 6.3
Printer.CurrentY = Y1 + 1
Printer.Print "线  路"
Printer.CurrentX = 6.3
Printer.CurrentY = Y1 + 1.5
Printer.Print "使用费"
Printer.CurrentX = 8
Printer.CurrentY = Y1 + 1.2
Printer.Print "空调费"
Printer.CurrentX = 9.7
Printer.CurrentY = Y1 + 1.2
Printer.Print "直接费"
Printer.CurrentX = 11.4
Printer.CurrentY = Y1 + 1
Printer.Print "车  站"
Printer.CurrentX = 11.4
Printer.CurrentY = Y1 + 1.5
Printer.Print "服务费"
Printer.CurrentX = 13.1
Printer.CurrentY = Y1 + 1
Printer.Print "代售票"
Printer.CurrentX = 13.1
Printer.CurrentY = Y1 + 1.5
Printer.Print "票务费"
Printer.CurrentX = 14.7
Printer.CurrentY = Y1 + 1
Printer.Print "营业外"
Printer.CurrentX = 14.7
Printer.CurrentY = Y1 + 1.5
Printer.Print "附加费"
Printer.CurrentX = 16.4
Printer.CurrentY = Y1 + 0.7
Printer.Print "合  计"

Printer.CurrentX = X1 + 0.4
Printer.CurrentY = Y1 + 3
Printer.Print Right(Text6(1), 6, 2)
Printer.CurrentX = 4.3
Printer.CurrentY = Y1 + 3
Printer.Print Right(Text6(2), 6, 2)
Printer.CurrentX = 6.1
Printer.CurrentY = Y1 + 3
Printer.Print Right(Text6(3), 6, 2)
Printer.CurrentX = 8
Printer.CurrentY = Y1 + 3
Printer.Print Right(Text6(4), 6, 2)
Printer.CurrentX = 9.7
Printer.CurrentY = Y1 + 3
Printer.Print Right(Text6(5), 6, 2)
Printer.CurrentX = 11.4
Printer.CurrentY = Y1 + 3
Printer.Print Right(Cb(cx(P), 1), 6, 2)
Printer.CurrentX = 13.2
Printer.CurrentY = Y1 + 3
Printer.Print Right(Cb(cx(P), 2), 6, 2)
Printer.CurrentX = 14.6
Printer.CurrentY = Y1 + 3
Printer.Print Right(Cb(cx(P), 3), 6, 2)
Printer.CurrentX = X1 + 14.15
Printer.CurrentY = Y1 + 3
Printer.Print Right(A1(cx(P), 2), 7, 2)
Printer.NewPage
Next P
Printer.EndDoc
Printer.KillDoc
Exit Sub
P1:
  MsgBox "     打印机尚未就绪，请准备好打印机  ！  ", vbExclamation, "提示信息"
End Sub