frmysdcount.frm

这是一个用VB编写出来的烟草管理系统

      End
   End
End
Attribute VB_Name = "frmysdcount"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim db As Database
Dim rs As Recordset
Dim rs1 As Recordset
Dim yzn As Integer
Dim coun As Integer

Private Sub Check1_Click()
    fhdwId = ""
    yzn = yzn + 1
    If yzn Mod 2 = 0 Then
        fhdwId.BackColor = &H8000000C
        fhdwId.Enabled = False
    Else
        fhdwId.BackColor = &H80000009
        fhdwId.Enabled = True
        fhdwId.SetFocus
    End If
End Sub

Private Sub Command1_Click()
    Set db = OpenDatabase(App.Path + "..\db\Data.mdb")
    Set rs = db.OpenRecordset("select * from dbd  order by Int(lsh)")
        If lshbegin = "" Or lshend = "" Then
            MsgBox ("请输入统计条件！"), vbOKOnly, ("！")
            lshbegin.SetFocus
            lshbegin = ""
            Command2.Enabled = False
        Else
            Command2.Enabled = True
            rs.MoveFirst
            For i = 1 To lshbegin - 1
                rs.MoveNext
            Next i
            cou = lshend - lshbegin + 1
            For j = 1 To coun
                MSF.TextMatrix(j, 4) = "0"
                MSF.TextMatrix(j, 5) = "0"
                MSF.TextMatrix(j, 6) = "0"
            Next j
            With MSF
                For k = 1 To coun
                    temyy = .TextMatrix(k, 1)
                    rs.MoveFirst
                    For i = 1 To lshbegin - 1
                        rs.MoveNext
                    Next i
                    For i = 1 To cou
                        temrs = UCase(rs.Fields("yfdj"))
                        If fhdwId <> "" Then
                            If temrs = temyy And fhdwId = rs.Fields("fhdwID") Then
                                .TextMatrix(k, 4) = .TextMatrix(k, 4) + rs.Fields("yfzl")
                                .TextMatrix(k, 5) = .TextMatrix(k, 5) + rs.Fields("sszl")
                            End If
                        Else
                            If temrs = temyy Then
                                .TextMatrix(k, 4) = .TextMatrix(k, 4) + rs.Fields("yfzl")
                                .TextMatrix(k, 5) = .TextMatrix(k, 5) + rs.Fields("sszl")
                            End If
                        End If
                        rs.MoveNext
                    Next i
                    .TextMatrix(k, 6) = .TextMatrix(k, 6) + .TextMatrix(k, 3) * .TextMatrix(k, 5)
                    .TextMatrix(k, 6) = Format(.TextMatrix(k, 6), "0.00")
                Next k
            End With
            rs.MoveFirst
            For i = 1 To lshbegin - 1
                rs.MoveNext
            Next i
            For n = 1 To cou
                If fhdwId <> "" Then
                    If UCase(rs.Fields("jjdj")) <> "NULL" And fhdwId = rs.Fields("fhdwID") Then
                        For m = 1 To coun
                            If MSF.TextMatrix(m, 1) = rs.Fields("jjdj") Then
                                MSF.TextMatrix(m, 5) = MSF.TextMatrix(m, 5) + rs.Fields("jjzl")
                                MSF.TextMatrix(m, 6) = MSF.TextMatrix(m, 3) * MSF.TextMatrix(m, 5)
                                MSF.TextMatrix(m, 6) = Format(MSF.TextMatrix(m, 6), "0.00")
                            End If
                        Next m
                    End If
                Else
                    If UCase(rs.Fields("jjdj")) <> "NULL" Then
                        For m = 1 To coun
                            If MSF.TextMatrix(m, 1) = rs.Fields("jjdj") Then
                                MSF.TextMatrix(m, 5) = MSF.TextMatrix(m, 5) + rs.Fields("jjzl")
                                MSF.TextMatrix(m, 6) = MSF.TextMatrix(m, 3) * MSF.TextMatrix(m, 5)
                                MSF.TextMatrix(m, 6) = Format(MSF.TextMatrix(m, 6), "0.00")
                            End If
                        Next m
                    End If
                End If
                rs.MoveNext
            Next n
            temyfhz = 0
            temsshz = 0
            temjehz = 0
            For n = 1 To coun
                temyfhz = temyfhz + MSF.TextMatrix(n, 4)
                temsshz = temsshz + MSF.TextMatrix(n, 5)
                temjehz = temjehz + MSF.TextMatrix(n, 6)
            Next n
            yfhz = temyfhz
            sshz = temsshz
            jehz = Int(temjehz * 100) / 100
            xxs = Int(jehz * 13) / 100
            ts = (yfhz - sshz) / yfhz * 100
            Command2.SetFocus
        End If
End Sub

Private Sub Command2_Click()
    CurtPrinter1.Visible = True
    PrintContent toPreview
End Sub

Private Sub Form_Load()
    yzn = 0
    CurtPrinter1.Visible = False
    Command2.Enabled = False
    With MSF
        .Font.Size = 9
        .Rows = 1
        .ColWidth(0) = .Width * 9 / 100
        .ColWidth(1) = .Width * 16 / 100
        .ColWidth(2) = .Width * 16 / 100
        .ColWidth(3) = .Width * 14 / 100
        .ColWidth(4) = .Width * 18 / 100
        .ColWidth(5) = .Width * 18 / 100
        .ColWidth(6) = .Width * 36 / 100
        .Col = 0: .Row = 0
        .Text = "序号"
        .Col = 1: .Row = 0
        .Text = "烟叶代码"
        .Col = 2: .Row = 0
        .Text = "烟叶等级"
        .Col = 3: .Row = 0
        .Text = "调拨价"
        .Col = 4: .Row = 0
        .Text = "原发重量"
        .Col = 5: .Row = 0
        .Text = "实收重量"
        .Col = 6: .Row = 0
        .Text = "实收金额(调拨价)"
    End With
    Set db = OpenDatabase(App.Path + "..\db\System.mdb")
    Set rs = db.OpenRecordset("yy")
    If rs.EOF = False Then
        rs.MoveFirst
        coun = 0
        Do Until rs.EOF
            coun = coun + 1
            rs.MoveNext
        Loop
        rs.MoveFirst
        With MSF
            For i = 1 To coun
                .AddItem Str(i)
                .Col = 1: .Row = i
                .Text = UCase(rs.Fields("yycode"))
                .Col = 2: .Row = i
                .Text = rs.Fields("yymc")
                .Col = 3: .Row = i
                .Text = rs.Fields("dbj")
                rs.MoveNext
            Next i
        End With
    End If
    db.Close
    With CurtPrinter1
        .PaperSize = "256"
        .PaperWidth = 380
        .PaperHeight = 280
    End With
End Sub
Private Sub lshbegin_Click()
    lshbegin.SetFocus
    lshbegin = ""
    Command2.Enabled = False
End Sub

Private Sub lshbegin_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        lshend.SetFocus
        lshend = ""
    End If
End Sub
Private Sub lshend_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        Check1.SetFocus
    End If
End Sub
Private Sub fhdwID_KeyPress(KeyAscii As Integer)
    If KeyAscii = vbKeyReturn Then
        Set db1 = OpenDatabase(App.Path + "..\db\System.mdb")
        Set rs = db1.OpenRecordset("select yz.yzmc from yz where yzId =" + Chr$(34) + fhdwId + Chr$(34) + ";")
        If rs.EOF = False Then
            fhmc = rs.Fields("yzmc")
            db1.Close
            Command1.SetFocus
        Else
            MsgBox ("库中没有此烟站信息！"), vbOKOnly, ("警告")
            db1.Close
            fhdwId = ""
            fhdwId.SetFocus
        End If
    End If
End Sub
Private Sub Form_Resize()
    CurtPrinter1.Move 0, 0, ScaleWidth, ScaleHeight
End Sub
Private Sub CurtPrinter1_PrintFooter(CurrentPage As Long, LeftText As String, CenterText As String, RightText As String)
    LeftText = "作者：敖显昌"
    CenterText = "第" & CurrentPage & "页"
    RightText = "联系我：[e-mail]"
End Sub
Private Sub curtprinter1_ClosePreview()
    CurtPrinter1.Visible = False
    Command2.Enabled = False
    MSF.Font.Size = 9
    lshbegin = ""
    lshend = ""
    lshbegin.SetFocus
End Sub
Private Sub curtprinter1_NeedRedraw()
    PrintContent toPreview
End Sub
Private Sub curtprinter1_RealPrint()
    PrintContent toPrinter
End Sub
Private Sub PrintContent(printDevice As PrintTo)
    Dim TableStartX As Single
    Dim CellHeight As Single
    Dim TempX As Single, TempY As Single
    CurtPrinter1.StartPrint printDevice
    With CurtPrinter1
        .NewPage
        MSF.Font.Size = 12
        MSF.Rows = coun + 3
        MSF.TextMatrix(coun + 1, 0) = "合计"
        MSF.TextMatrix(coun + 1, 4) = yfhz
        MSF.TextMatrix(coun + 1, 5) = sshz
        MSF.TextMatrix(coun + 1, 6) = Format(jehz, "0.00")
        MSF.TextMatrix(coun + 2, 3) = "销项税"
        MSF.TextMatrix(coun + 2, 4) = xxs
        MSF.TextMatrix(coun + 2, 5) = "途损"
        MSF.TextMatrix(coun + 2, 6) = Format(ts / 100, "0.000%")
        .TitleOut Format(Now, "yyyy-mm-dd"), 9, vbRightJustify
        If fhdwId <> "" Then
            .TitleOut "烟叶调拨单统计(" + fhmc + ")", 20
        Else
            .TitleOut "烟叶调拨单统计(县公司)", 20
        End If
        .TitleOut "流水号：从" + lshbegin + "到" + lshend, 9, vbLeftJustify
        .DirectPrint MSF
        .EndDoc
    End With
End Sub