form2.frm

vb+sql 用于公交点钞结算和报表结合的相关软件

'''            Loop
'''            myoutput.unitecell "A" + CStr(i), "E" + CStr(i)
'''            myoutput.Addcell i, 1, " 制表人:" + Trim(cCheckName) + "                                         制表日期:" + Format(dtpDcyDate.Value, "yyyy年MM月dd日")
'''            myoutput.unitecell "A" + CStr(i), "E" + CStr(i)
'''            rs.Close
'''        End If
'''    End If

    Dim rs  As New ADODB.Recordset
    Dim INPUTDATE, STime As String
    
    Dim PaperCols, PaperRows, PaperCopies As Integer
    Dim RowSpace, ColSpace As Integer
    Dim myoutput As New ReportToExcel.mClass
    Dim MYPATH As String
    Dim i, DCYcount As Integer
    Dim Rcount, Ccount As Integer
    Dim STARTDATE As String

    INPUTDATE = Format(dtpDcyDate.Value, "yyyymmdd")
    If CInt(Mid(INPUTDATE, 7, 2)) < 25 Then
        STARTDATE = CStr(CDbl(Left(INPUTDATE, 6)) - 1) + "25"
    Else
        STARTDATE = CStr(Left(INPUTDATE, 6)) + "25"
    End If
    STime = Format(dtpDcyDate.Value, "yyyy年mm月dd日")


    If cmbSelect.ListIndex = 1 Then '现金报表
    
    
        DCYcount = 1
        PaperCols = 3: PaperRows = 2
        RowSpace = 2: ColSpace = 1
        'cnn.Open strCollection
        Set rs = New ADODB.Recordset
        
        
        Do While DCYcount <= lstDcy(1).ListItems.Count
            
            MYPATH = CStr(App.Path) + "\money.xlt" '设置模版路径
            myoutput.StartModel MYPATH, 1
            
            For Rcount = 1 To PaperRows
                If DCYcount > lstDcy(1).ListItems.Count Then
                    Exit For
                End If
                For Ccount = 1 To PaperCols
                    If DCYcount <= lstDcy(1).ListItems.Count Then
            
                        rs.Open "ZYSP_DCY_MONEY_COUNT  " & INPUTDATE & "," & lstDcy(1).ListItems(DCYcount).ListSubItems(2).Text, cnn, adOpenStatic, adLockOptimistic
                        If Not rs.EOF Then
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 2, (3 + ColSpace) * (Ccount - 1) + 1, "点款日期:" & STime
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 4, (3 + ColSpace) * (Ccount - 1) + 2, IIf(CStr(rs(0).Value) = "0", "", CStr(rs(0).Value))
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 4, (3 + ColSpace) * (Ccount - 1) + 3, IIf(CStr(rs(0).Value * 100) = "0", "", CStr(rs(0).Value * 100)) '100
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 5, (3 + ColSpace) * (Ccount - 1) + 2, IIf(CStr(rs(1).Value) = "0", "", CStr(rs(1).Value))
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 5, (3 + ColSpace) * (Ccount - 1) + 3, IIf(CStr(rs(1).Value * 50) = "0", "", CStr(rs(1).Value * 50)) '50
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 6, (3 + ColSpace) * (Ccount - 1) + 2, IIf(CStr(rs(2).Value) = "0", "", CStr(rs(2).Value))
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 6, (3 + ColSpace) * (Ccount - 1) + 3, IIf(CStr(rs(2).Value * 20) = "0", "", CStr(rs(2).Value * 20)) '20
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 7, (3 + ColSpace) * (Ccount - 1) + 2, IIf(CStr(rs(3).Value) = "0", "", CStr(rs(3).Value))
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 7, (3 + ColSpace) * (Ccount - 1) + 3, IIf(CStr(rs(3).Value * 10) = "0", "", CStr(rs(3).Value * 10)) '10
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 8, (3 + ColSpace) * (Ccount - 1) + 2, IIf(CStr(rs(4).Value) = "0", "", CStr(rs(4).Value))
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 8, (3 + ColSpace) * (Ccount - 1) + 3, IIf(CStr(rs(4).Value * 5) = "0", "", CStr(rs(4).Value * 5)) '5
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 9, (3 + ColSpace) * (Ccount - 1) + 2, IIf(CStr(rs(5).Value) = "0", "", CStr(rs(5).Value))
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 9, (3 + ColSpace) * (Ccount - 1) + 3, IIf(CStr(rs(5).Value * 2) = "0", "", CStr(rs(5).Value * 2)) '2
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 10, (3 + ColSpace) * (Ccount - 1) + 2, IIf(CStr(rs(6).Value) = "0", "", CStr(rs(6).Value))
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 10, (3 + ColSpace) * (Ccount - 1) + 3, IIf(CStr(rs(6).Value * 1) = "0", "", CStr(rs(6).Value * 1)) '1
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 11, (3 + ColSpace) * (Ccount - 1) + 2, IIf(CStr(rs(7).Value) = "0", "", CStr(rs(7).Value))
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 11, (3 + ColSpace) * (Ccount - 1) + 3, IIf(CStr(rs(7).Value * 0.5) = "0", "", CStr(rs(7).Value * 0.5)) '0.5
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 12, (3 + ColSpace) * (Ccount - 1) + 2, IIf(CStr(rs(8).Value) = "0", "", CStr(rs(8).Value))
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 12, (3 + ColSpace) * (Ccount - 1) + 3, IIf(CStr(rs(8).Value * 0.2) = "0", "", CStr(rs(8).Value * 0.2)) '0.2
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 13, (3 + ColSpace) * (Ccount - 1) + 2, IIf(CStr(rs(9).Value) = "0", "", CStr(rs(9).Value))
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 13, (3 + ColSpace) * (Ccount - 1) + 3, IIf(CStr(rs(9).Value * 0.1) = "0", "", CStr(rs(9).Value * 0.1)) '0.1
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 14, (3 + ColSpace) * (Ccount - 1) + 2, IIf(CStr(rs(10).Value) = "0", "", CStr(rs(10).Value))
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 14, (3 + ColSpace) * (Ccount - 1) + 3, IIf(CStr(rs(10).Value * 0.05) = "0", "", CStr(rs(10).Value * 0.05)) '0.05
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 15, (3 + ColSpace) * (Ccount - 1) + 2, IIf(CStr(rs(11).Value) = "0", "", CStr(rs(11).Value))
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 15, (3 + ColSpace) * (Ccount - 1) + 3, IIf(CStr(rs(11).Value * 0.02) = "0", "", CStr(rs(11).Value * 0.02)) '0.02
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 16, (3 + ColSpace) * (Ccount - 1) + 2, IIf(CStr(rs(12).Value) = "0", "", CStr(rs(12).Value))
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 16, (3 + ColSpace) * (Ccount - 1) + 3, IIf(CStr(rs(12).Value * 0.01) = "0", "", CStr(rs(12).Value * 0.01)) '0.01
                            
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 17, (3 + ColSpace) * (Ccount - 1) + 2, IIf(CStr(rs(13).Value) = "0", "", CStr(rs(13).Value))
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 17, (3 + ColSpace) * (Ccount - 1) + 3, IIf(CStr(rs(14).Value) = "0", "", CStr(rs(14).Value))   '0.01
                            
                            myoutput.Addcell (18 + RowSpace) * (Rcount - 1) + 18, (3 + ColSpace) * (Ccount - 1) + 1, "点钞员:" & lstDcy(1).ListItems(DCYcount).ListSubItems(2).Text & "  " & lstDcy(1).ListItems(DCYcount).ListSubItems(1).Text
                            
                        End If
                        rs.Close
                        DCYcount = DCYcount + 1
                    Else
                        Exit For
                    End If 'Next
                    'DCYcount = Ccount * Rcount + 1
                Next
            
            Next
        myoutput.PRINTDOC 1
        myoutput.QUIT
        Loop
   Else '点超量
        MYPATH = CStr(App.Path) + "\money.xlt" '设置模版路径
        myoutput.StartModel MYPATH, 2
        myoutput.Addcell 2, 1, "数据日期：  " & Format(dtpDcyDate.Value, "yyyy年mm月dd日")

        DCYcount = 1
        Dim DCY(4) As Double
        myoutput.Addcell (DCYcount + 3), 1, lstDcy(1).ListItems(DCYcount).ListSubItems(2).Text
        myoutput.Addcell (DCYcount + 3), 2, lstDcy(1).ListItems(DCYcount).ListSubItems(1).Text
        For DCYcount = 1 To lstDcy(1).ListItems.Count
            myoutput.Addcell (DCYcount + 3), 1, lstDcy(1).ListItems(DCYcount).ListSubItems(2).Text
            myoutput.Addcell (DCYcount + 3), 2, lstDcy(1).ListItems(DCYcount).ListSubItems(1).Text

            rs.Open "ZYSP_DCY_MONEY_QUANTITY  " & INPUTDATE & "," & INPUTDATE & "," & lstDcy(1).ListItems(DCYcount).ListSubItems(2).Text, cnn, adOpenStatic, adLockOptimistic
            If Not rs.EOF Then
                myoutput.Addcell (DCYcount + 3), 3, rs(1).Value
                myoutput.Addcell (DCYcount + 3), 4, rs(2).Value
                DCY(1) = DCY(1) + rs(1).Value
                DCY(2) = DCY(2) + rs(2).Value
            End If
            rs.Close
            rs.Open "ZYSP_DCY_MONEY_QUANTITY  " & STARTDATE & "," & INPUTDATE & "," & lstDcy(1).ListItems(DCYcount).ListSubItems(2).Text, cnn, adOpenStatic, adLockOptimistic
            If Not rs.EOF Then
                myoutput.Addcell (DCYcount + 3), 5, rs(1).Value
                myoutput.Addcell (DCYcount + 3), 6, rs(2).Value
                DCY(3) = DCY(3) + rs(1).Value
                DCY(4) = DCY(4) + rs(2).Value
            End If
            rs.Close
            
        Next
        myoutput.Addcell (DCYcount + 3), 3, CStr(DCY(1))
        myoutput.Addcell (DCYcount + 3), 4, CStr(DCY(2))
        myoutput.Addcell (DCYcount + 3), 5, CStr(DCY(3))
        myoutput.Addcell (DCYcount + 3), 6, CStr(DCY(4))
        myoutput.Addcell (DCYcount + 3), 1, "合计"
        
   End If

End Sub

Private Function addSpace(aa As String) As String
    Dim iLenStr As Integer
    iLenStr = Len(aa)
        Select Case iLenStr
            Case 1
                addSpace = "      " + aa
            Case 2
                addSpace = "     " + aa
            Case 3
                addSpace = "    " + aa
            Case 4
                addSpace = "   " + aa
            Case 5
                addSpace = "  " + aa
            Case 6
                addSpace = " " + aa
            Case Else
                addSpace = aa
            
        End Select

End Function

Private Sub cmdRemove_Click()
    Dim jNum As Integer
    jNum = lstDcy(0).ListItems.Count + 1
    For i = 1 To lstDcy(1).ListItems.Count
        If i > lstDcy(1).ListItems.Count Then Exit Sub
        If lstDcy(1).ListItems(i).Selected = True Then
            lstDcy(0).ListItems.Add , lstDcy(1).ListItems(i).Key, lstDcy(1).ListItems(i).Text
            lstDcy(0).ListItems(jNum).ListSubItems.Add , lstDcy(1).ListItems(i).ListSubItems(1).Key, lstDcy(1).ListItems(i).ListSubItems(1).Text
            lstDcy(0).ListItems(jNum).ListSubItems.Add , lstDcy(1).ListItems(i).ListSubItems(2).Key, lstDcy(1).ListItems(i).ListSubItems(2).Text
            lstDcy(1).ListItems.Remove i
            jNum = jNum + 1
            i = i - 1
        End If
    Next i
End Sub

Private Sub cmdRemoveAll_Click()
    For i = 1 To lstDcy(1).ListItems.Count
        lstDcy(1).ListItems.Remove 1
    Next
    For i = 1 To lstDcy(0).ListItems.Count
        lstDcy(0).ListItems.Remove 1
    Next
    Call lstRef(0)
End Sub

Private Sub Command1_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    Call lstRef(0)
    dtpDcyDate.Value = Now - 1
    cmbSelect.ListIndex = 1
End Sub
Private Sub lstRef(Index As Integer)
    Dim rs As New ADODB.Recordset
    rs.Open "select opno,opname,OP_NO from amc_dcy_info order by opno", cnn, adOpenStatic, adLockOptimistic
    i = 1
    Do While Not rs.EOF
        lstDcy(Index).ListItems.Add , "A" + CStr(i), rs.Fields(0)
        lstDcy(Index).ListItems(i).ListSubItems.Add , "b" + CStr(i), Trim(rs.Fields(1))
        lstDcy(Index).ListItems(i).ListSubItems.Add , "C" + CStr(i), rs.Fields(2)
        rs.MoveNext
       i = i + 1
    Loop
    txtNewOpNo = lstDcy(Index).ListItems.Count + 1
End Sub

Private Sub lstDcy_DblClick(Index As Integer)
    If Index = 0 Then
        Call cmdAdd_Click
    Else
        Call cmdRemove_Click
    End If
End Sub