分部统计.frm

一个商场财务系统

   End
End
Attribute VB_Name = "分部统计"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim A(6) As String, B(1 To 13) As String
Dim S(1 To 6) As String, D(1 To 6) As String, E(1 To 6) As String
Dim I As Integer, K As String
Dim T1 As Single, T2 As Single, N As String
Dim H1(12) As Single, H2(12) As Single, H3(12) As Single
Dim Hj1 As Single, Hj2 As Single
Dim L1(12) As Single, L2(12) As Single, L3(12) As Single
Dim Y As Single, X As Single
Private Sub Form_Load()
Me.Left = 0: Me.Top = 0
Label1.Left = (Me.ScaleWidth - Label1.Width) / 2
Shape1.Left = (Me.ScaleWidth - Shape1.Width) / 2
ScaleMode = 3
Y = 55
    Line (28, 80)-(767, 409), RGB(255, 255, 255), BF
    Line (27, 80)-(767, 409), , B
For Y = 80 To 411 Step 23.5
    Line (29, Y)-(767, Y)
Next Y
For X = 27 To 767 Step 106
    Line (X, 80)-(X, 410)
Next X
  Adodc1.ConnectionString = "Provider=MSDASQL.1;Persist Security Info=False;Extended Properties=DSN=商场帐务;APP=Visual Basic;WSID=YAO_WEI_SERVER;DATABASE=商场帐务;Trusted_Connection=Yes"
  Adodc2.ConnectionString = "Provider=MSDASQL.1;Persist Security Info=False;Extended Properties=DSN=商场帐务;APP=Visual Basic;WSID=YAO_WEI_SERVER;DATABASE=商场帐务;Trusted_Connection=Yes"
    A(0) = "月   份": A(1) = "收   入": A(2) = "支   出": A(3) = "余   额": A(4) = "收入累计": A(5) = "支出累计": A(6) = "累计累计"
    B(1) = "一  月": B(2) = "二  月": B(3) = "三  月": B(4) = "四  月": B(5) = "五  月": B(6) = "六  月"
    B(7) = "七  月": B(8) = "八  月": B(9) = "九  月": B(10) = "十  月": B(11) = "十一月": B(12) = "十二月"
    B(13) = "合  计"
    D(1) = "糖茶饮料部": D(2) = "家用电器部": D(3) = "文教用品部": D(4) = "服装部"
    D(5) = "鞋帽部": D(6) = "食品部"
    E(1) = "糖茶饮料部年度累计": E(2) = "家用电器部年度累计": E(3) = "文教用品部年度累计"
    E(4) = "服装部年度累计": E(5) = "鞋帽部年度累计": E(6) = "食品部年度累计"
    S(1) = "年糖茶饮料部年度统计表": S(2) = "年家用电器部年度统计表": S(3) = "年文教用品部年度统计表"
    S(4) = " 年服装部年度统计表": S(5) = " 年鞋帽部年度统计表": S(6) = " 年食品部年度统计表"
    FontSize = 12
  CurrentX = 514: CurrentY = 426
Print "统计日期： " + Format(Date, "yyyy 年 m 月 d 日")
End Sub
Private Sub Command1_Click()
    Call Prn
End Sub
Private Sub Command2_Click()
    Unload Me
End Sub
Private Sub Option1_Click()
    Command1.Enabled = True
    K = 1: Call Tj
End Sub
Private Sub Option2_Click()
    Command1.Enabled = True
    K = 2: Call Tj
End Sub
Private Sub Option3_Click()
    Command1.Enabled = True
    K = 3: Call Tj
End Sub
Private Sub Option4_Click()
    Command1.Enabled = True
    K = 4: Call Tj
End Sub
Private Sub Option5_Click()
    Command1.Enabled = True
    K = 5: Call Tj
End Sub
Private Sub Option6_Click()
    Command1.Enabled = True
    K = 6: Call Tj
End Sub
Private Sub Tj()
For J = 0 To 12
    H1(J) = 0: H2(J) = 0: H3(J) = 0
    L1(J) = 0: L2(J) = 0: L3(J) = 0
Next J
Label1.Caption = "  " + 年度选择.YearData + S(K)
ScaleMode = 3
Y = 55
    Line (28, 80)-(766, 409), RGB(255, 255, 255), BF
For Y = 80 To 409 Step 23.5
    Line (29, Y)-(767, Y)
Next Y
For X = 27 To 767 Step 106
    Line (X, 80)-(X, 409)
Next X
    FontSize = 10
    X = 52
For I = 0 To 6
    CurrentX = X: CurrentY = 85
    Print Right(A(I), 0, 6)
    X = X + 104
Next I
I = 1
For Y = 108.5 To 409 Step 23.5
    CurrentX = 50: CurrentY = Y
    Print B(I)
    I = I + 1
Next Y
    Adodc1.RecordSource = D(K)
    Adodc1.Refresh
    Adodc1.Recordset.MoveLast
    Adodc1.Recordset.MoveFirst
    Num = Adodc1.Recordset.RecordCount
  For I = 1 To Num
  If Mid(Text1, 1, 4) = 年度选择.YearData Then
  Select Case Val(Mid(Text1, 6, 2))
     Case 1
     H1(1) = H1(1) + Val(Text2): H2(1) = H2(1) + Val(Text3)
     Case 2
     H1(2) = H1(2) + Val(Text2): H2(2) = H2(2) + Val(Text3)
     Case 3
     H1(3) = H1(3) + Val(Text2): H2(3) = H2(3) + Val(Text3)
     Case 4
     H1(4) = H1(4) + Val(Text2): H2(4) = H2(4) + Val(Text3)
     Case 5
     H1(5) = H1(5) + Val(Text2): H2(5) = H2(5) + Val(Text3)
     Case 6
     H1(6) = H1(6) + Val(Text2): H2(6) = H2(6) + Val(Text3)
     Case 7
     H1(7) = H1(7) + Val(Text2): H2(7) = H2(7) + Val(Text3)
     Case 8
     H1(8) = H1(8) + Val(Text2): H2(8) = H2(8) + Val(Text3)
     Case 9
     H1(9) = H1(9) + Val(Text2): H2(9) = H2(9) + Val(Text3)
     Case 10
     H1(10) = H1(10) + Val(Text2): H2(10) = H2(10) + Val(Text3)
     Case 11
     H1(11) = H1(11) + Val(Text2): H2(11) = H2(11) + Val(Text3)
     Case 12
     H1(12) = H1(12) + Val(Text2): H2(12) = H2(12) + Val(Text3)
    End Select
   End If
   Adodc1.Recordset.MoveNext
  Next I
    N = 年度选择.YearData - 1
    Adodc2.RecordSource = "Select * from " + E(K) + " Where [年份] = " + "'" + N + "'"
    Adodc2.Refresh
    If Text5 <> "" Then
    L1(0) = Val(Text5): L2(0) = Val(Text6)
    Else
    L1(0) = 0: L2(0) = 0
    End If
    Hj1 = 0: Hj2 = 0
  For I = 1 To 12
     Hj1 = Hj1 + H1(I): Hj2 = Hj2 + H2(I)
     H3(I) = H1(I) - H2(I): L1(I) = L1(I) + H1(I) + L1(I - 1)
     L2(I) = L2(I) + H2(I) + L2(I - 1): L3(I) = L3(I) + H3(I) + L1(I - 1) - L2(I - 1)
  Next I
FontSize = 10: Y = 110
For I = 1 To 12
    X = 170: CurrentX = X: CurrentY = Y: Print Right(H1(I), 9, 2)
    X = X + 105: CurrentX = X: CurrentY = Y: Print Right(H2(I), 9, 2)
    X = X + 105: CurrentX = X: CurrentY = Y: Print Right(H3(I), 9, 2)
    X = X + 105: CurrentX = X: CurrentY = Y: Print Right(L1(I), 9, 2)
    X = X + 105: CurrentX = X: CurrentY = Y: Print Right(L2(I), 9, 2)
    X = X + 105: CurrentX = X: CurrentY = Y: Print Right(L3(I), 9, 2)
    Y = Y + 23.5
Next I
  N = 年度选择.YearData
    Adodc2.RecordSource = "Select * from " + E(K) + " Where [年份] = " + "'" + N + "'"
    Adodc2.Refresh
   If Text4 = "" Then
    Adodc2.Recordset.AddNew
    Text4 = 年度选择.YearData: Text5 = L1(12): Text6 = L2(12)
    Else
    Text4 = 年度选择.YearData: Text5 = L1(12): Text6 = L2(12)
   End If
    X = 170: CurrentX = X: CurrentY = Y: Print Right(Hj1, 9, 2)
    X = X + 105: CurrentX = X: CurrentY = Y: Print Right(Hj2, 9, 2)
    X = X + 105: CurrentX = X: CurrentY = Y: Print Right(Hj1 - Hj2, 9, 2)
    X = X + 105: CurrentX = X: CurrentY = Y: Print Right(L1(12), 9, 2)
    X = X + 105: CurrentX = X: CurrentY = Y: Print Right(L2(12), 9, 2)
    X = X + 105: CurrentX = X: CurrentY = Y: Print Right(L1(12) - L2(12), 9, 2)
End Sub
Private Sub Prn()
    Printer.ScaleMode = 6
    Printer.CurrentX = 55: Printer.CurrentY = 40
    Printer.FontSize = 20
    Printer.Print 年度选择.YearData + S(K)
    Printer.FontSize = 10
Y = 55
    Printer.Line (25, 50)-(165, 127), , B
For Y = 50 To 129 Step 5.5
    Printer.Line (25, Y)-(165, Y)
Next Y
For X = 45 To 145 Step 20
    Printer.Line (X, 50)-(X, 127)
Next X
X = 29
For I = 0 To 6
    Printer.CurrentX = X
    Printer.CurrentY = 51
    Printer.Print A(I)
        If I <= 4 Then
         X = X + 20
         Else
         X = X + 19
        End If
Next I
I = 1
For Y = 56 To 124.5 Step 5.5
    Printer.CurrentX = 30
    Printer.CurrentY = Y
    Printer.Print B(I)
    I = I + 1
Next Y
FontSize = 10: Y = 56
For I = 1 To 12
    X = 51: Printer.CurrentX = X: Printer.CurrentY = Y
        Printer.Print Right(H1(I), 7, 2)
    X = X + 20: Printer.CurrentX = X: Printer.CurrentY = Y
        Printer.Print Right(H2(I), 7, 2)
    X = X + 20: Printer.CurrentX = X: Printer.CurrentY = Y
        Printer.Print Right(H3(I), 7, 2)
    X = X + 20: Printer.CurrentX = X: Printer.CurrentY = Y
        Printer.Print Right(L1(I), 7, 2)
    X = X + 20: Printer.CurrentX = X: Printer.CurrentY = Y
        Printer.Print Right(L2(I), 7, 2)
    X = X + 20: Printer.CurrentX = X: Printer.CurrentY = Y
        Printer.Print Right(L3(I), 7, 2)
    Y = Y + 5.5
Next I
X = 49
    Printer.CurrentX = X: Printer.CurrentY = Y
    Printer.Print Right(Hj1, 8, 2)
X = X + 20
    Printer.CurrentX = X: Printer.CurrentY = Y
    Printer.Print Right(Hj2, 8, 2)
X = X + 20
    Printer.CurrentX = X: Printer.CurrentY = Y
    Printer.Print Right(Hj1 - Hj2, 8, 2)
X = X + 20
    Printer.CurrentX = X: Printer.CurrentY = Y
    Printer.Print Right(L1(12), 8, 2)
X = X + 20
    Printer.CurrentX = X: Printer.CurrentY = Y
    Printer.Print Right(L2(12), 8, 2)
X = X + 20
    Printer.CurrentX = X: Printer.CurrentY = Y
    Printer.Print Right(L1(12) - L2(12), 8, 2)
    Printer.FontSize = 10
    Printer.CurrentX = 110: Printer.CurrentY = 130
    Printer.Print "统计日期： " + Format(Date, "yyyy 年 m 月 d 日")
Printer.EndDoc
Printer.KillDoc
End Sub
Public Function Right(ByVal Xz As String, ByVal L As Integer, ByVal D As Integer) As String
  Dim L1 As Integer, N As Integer
  Dim Space As String, J As Integer
  Dim Z As String
    For J = 1 To D
     Z = Z + "0"
    Next J
  If D <> 0 Then
     Z = "0." & Z
     Xz = Format(Xz, Z)
     L1 = Len(Xz)
     Else
     Xz = Format(Xz, Z)
     L1 = Len(Xz)
  End If
    If L1 < L Then
     N = L - L1
     For J = 1 To N
      Space = Space & " "
     Next J
     Right = Space & Xz
    Else
     Right = Xz
    End If
End Function