VB财务软件系统下载源代码提供自由下载使用学习

               CX_SumCHAR & Chr(9) & CX_SumCHAR & Chr(9) & CX_SumCHAR & _
               Chr(9) & CX_SumCHAR & _
               Chr(9) & CX_SumCHAR & Chr(9) & FormatCur(CX_Sum(i).mMoney) & Chr(9) & _
               CX_Sum(i).sExchName & Chr(9) & CX_SumCHAR & Chr(9) & FormatCur(CX_Sum(i).mMoney_1) & _
               Chr(9) & FormatCur(CX_Sum(i).mMoney_2) & Chr(9) & CX_SumCHAR & _
               Chr(9) & CX_SumCHAR & Chr(9) & CX_SumCHAR & _
               Chr(9) & CX_SumCHAR & Chr(9) & CX_SumCHAR & Chr(9) & CX_SumCHAR & Chr(9) & _
               CX_SumCHAR & Chr(9) & CX_SumCHAR & Chr(9) & CX_SumCHAR & Chr(9) & CX_SumCHAR
'               CX_Sum(i).sExchName & Chr(9) & CX_Sum(i).nFrat & Chr(9) & FormatCur(CX_Sum(i).mMoney_F) & _ 'cuidong S.B 2001.09.13
          Next i
         '-----------------------------------------
      
      Case 9      '利息单
         Dim strClass1 As String
         Dim pUnit As String
         Dim gUnit As String
         Dim cExch As String
         Dim xFs As String
         Set rsClass = dbsZJ.OpenRecordset("SELECT * FROM FD_Class WHERE cSign='16'")
         strClass = rsClass![ctext]
         i = 1
         With rsFind
         
         While Not .EOF And i <= nMaxRows
            If Not IsNull(![cDanID]) Then
               Set rsClass = dbsZJ.OpenRecordset("SELECT * FROM FD_Class WHERE cSign='" & Left(![cDanID], 2) & "'")
               strClass1 = rsClass![ctext] & "-" & Right(![cDanID], 8)
            Else
               strClass1 = ""
            End If
            If ![iDanType] = 2 Then
               xFs = Getjxfs(![iartyp])
            Else
               xFs = ""
            End If
            If IsNull(![cGAccID]) Then
               gUnit = ""
            Else
               gUnit = AccIDToUnitName(![cGAccID])
            End If
            If IsNull(![cPAccID]) Then
               pUnit = ""
            Else
               pUnit = AccIDToUnitName(![cPAccID])
            End If
            If IsNull(![cGAccID]) Then
               cExch = AccToExch(![cPAccID])
            Else
               cExch = AccToExch(![cGAccID])
            End If
            StatusBarChanged rsClass![ctext], Right(rsFind![cCarID], 8)
            If Not iThisRW = iRW Then Exit Sub  '重新查询，则退出本任务 'Cuidong 2000.12.24
            
            UfGridADO1.AddItem _
               Year(![dbill_date]) & Chr(9) & Month(![dbill_date]) & Chr(9) & _
               Day(![dbill_date]) & Chr(9) & gUnit & Chr(9) & _
               ![cGAccID] & Chr(9) & pUnit & Chr(9) & _
               ![cPAccID] & Chr(9) & strClass & "-" & Right(![cCarID], 8) & _
               Chr(9) & ![cDigest] & Chr(9) & FormatCur(![mMoney]) & Chr(9) & _
               cExch & Chr(9) & Vround(![nFrat], 6) & Chr(9) & FormatCur(![mMoney_F]) & _
               Chr(9) & strClass1 & Chr(9) & FormatDate(![dFrom]) & Chr(9) & FormatDate(![dTo]) & Chr(9) & _
               ![cIntrID] & Chr(9) & ![cCadID] & Chr(9) & _
               xFs & Chr(9) & ![cBillCode] & Chr(9) & ![cCheckCode] & Chr(9) & ![cBookCode]
                  
            CX_Sum_Add FormatCur(![mMoney]), cExch, Vround(![nFrat], 6), FormatCur(![mMoney_F]) 'cuidong S.A 2001.09.11
                  
               .MoveNext
               i = i + 1
         Wend
         End With
      
         'cuidong S.A 2001.09.11
         '-----------------------------------------
         For i = 1 To UBound(CX_Sum)
            UfGridADO1.AddItem _
               CX_SumTEXT & Chr(9) & CX_SumCHAR & Chr(9) & _
               CX_SumCHAR & Chr(9) & CX_SumCHAR & Chr(9) & _
               CX_SumCHAR & Chr(9) & CX_SumCHAR & Chr(9) & _
               CX_SumCHAR & Chr(9) & CX_SumCHAR & _
               Chr(9) & CX_SumCHAR & Chr(9) & FormatCur(CX_Sum(i).mMoney) & Chr(9) & _
               CX_Sum(i).sExchName & Chr(9) & CX_SumCHAR & Chr(9) & FormatCur(CX_Sum(i).mMoney_1) & _
               Chr(9) & CX_SumCHAR & Chr(9) & CX_SumCHAR & Chr(9) & CX_SumCHAR & Chr(9) & _
               CX_SumCHAR & Chr(9) & CX_SumCHAR & Chr(9) & _
               CX_SumCHAR & Chr(9) & CX_SumCHAR & Chr(9) & CX_SumCHAR & Chr(9) & CX_SumCHAR
'               CX_Sum(i).sExchName & Chr(9) & CX_Sum(i).nFrat & Chr(9) & FormatCur(CX_Sum(i).mMoney_F) & _ 'cuidong S.B 2001.09.13
          Next i
         '-----------------------------------------
      
   End Select
   
End Sub

Private Sub StatusBarChanged(strText As String, strID As String)
   StatusBar1.Panels(2).Text = strText & "： " & strID
   ProBar1.Value = ProBar1.Value + 1
   DoEvents

End Sub

Private Sub GetCreInfo(CreID As String, ByRef CreDate As Date, ByRef RetDate As Date, ByRef strInstr As String)
    'CuiDong Efficiency-A 2000/06/20 效率优化A OK
    Dim rsCred As New UfRecordset

'    Set rsCred = dbsZJ.OpenRecordset("FD_Cred", 2)  'CuiDong Efficiency-A 2000/06/20 效率优化A
    Set rsCred = dbsZJ.OpenRecordset("Select * From FD_Cred Where cCreID='" & CreID & "'", 2) 'CuiDong Efficiency-A 2000/06/20 效率优化A
    With rsCred
'        .Index = "PrimaryKey"                       'CuiDong Efficiency-A 2000/06/20 效率优化A
'        .Find "cCreID='" + CreID + "'"              'CuiDong Efficiency-A 2000/06/20 效率优化A
'        If Not .NoMatch Then                        'CuiDong Efficiency-A 2000/06/20 效率优化A
        If Not (.EOF Or .BOF) Then                   'CuiDong Efficiency-A 2000/06/20 效率优化A
            CreDate = ![dbill_date]
            RetDate = ![Dret_date]
            strInstr = ![cIntrID]
        End If
    End With
    rsCred.oClose

End Sub

Private Sub GetUnwInfo(UnwID As String, ByRef UnwDate As Date, ByRef RetDate_U As Date, ByRef strInstr_U As String)
    'CuiDong Efficiency-A 2000/06/20 效率优化A OK
    Dim rsUnw As New UfRecordset

'    Set rsUnw = dbsZJ.OpenRecordset("FD_UnwDeb", 2)  'CuiDong Efficiency-A 2000/06/20 效率优化A
    Set rsUnw = dbsZJ.OpenRecordset("Select * From FD_UnwDeb Where cUnwID='" & UnwID & "'", 2) 'CuiDong Efficiency-A 2000/06/20 效率优化A
    With rsUnw
'        .Index = "PrimaryKey"                        'CuiDong Efficiency-A 2000/06/20 效率优化A
'        .Find "cUnwID='" + UnwID + "'"               'CuiDong Efficiency-A 2000/06/20 效率优化A
'        If Not .NoMatch Then                         'CuiDong Efficiency-A 2000/06/20 效率优化A
        If Not (.EOF Or .BOF) Then                    'CuiDong Efficiency-A 2000/06/20 效率优化A
            UnwDate = ![dbill_date]
            RetDate_U = ![Dret_date]
            strInstr_U = ![cIntrID]
        End If
    End With
    rsUnw.oClose

End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)
   Gen_Key Button.key
End Sub

Private Sub Gen_Key(TLB_Key As String)
    Select Case TLB_Key
        Case Is = "Print", "Preview", "Dataout"
            zjbPrnViewOut Me, "cxrest", TLB_Key, False, Label1.Caption
        Case "Recx"
            Recx
        Case Is = "Lanmuxz"
             With frmItem
               Set .mGrid = Me.UfGridADO1
               .mStartCol = 3
               .Show vbModal
             End With
        Case Is = "Lcdj"
            UfGridado1_DBClick UfGridADO1.Row, UfGridADO1.Col
        Case Is = "Help"
            SendKeys "{F1}"
        Case Is = "Exit"
            Unload Me
    End Select
End Sub

Private Sub Recx()
   Select Case iFindtype
      Case 0, 1, 2, 3, 4, 5
         frmFind.Quitfs = False
         frmFind.iFindtype = iFindtype
         frmFind.Show vbModal
      Case Else
         frmFindLend.Quitfs = False
         frmFindLend.iFindtype = iFindtype
         frmFindLend.Show vbModal
   End Select
End Sub

Private Sub UfGridado1_DBClick(ByVal nRow As Long, ByVal nCol As Long)
   Dim xTemp As String, yTemp As String
   Dim cClass As String, sqlID As String
   Dim i As Integer
   Dim fndCred As clsCred, fndLend As clsLend, fndCad As clsCadBill
   Dim fndCredRet As clsCredRet, fndLendRet As clsLendRet
   
   If UfGridADO1.Row < 2 Then Exit Sub
   
   If UfGridADO1.TextMatrix(UfGridADO1.Row, 0) = CX_SumTEXT Then Exit Sub 'cuidong S.A 2001.09.11
   
   yTemp = UfGridADO1.TextMatrix(UfGridADO1.Row, UfGridADO1.Col)
   UfGridADO1.TextMatrix(UfGridADO1.Row, UfGridADO1.Col) = yTemp
   
   xTemp = UfGridADO1.TextMatrix(UfGridADO1.Row, IIf((iFindtype < 6), 5, 7))
   UfGridADO1.TextMatrix(UfGridADO1.Row, IIf((iFindtype < 6), 5, 7)) = xTemp
   
      sqlID = Right(xTemp, 8)
      If Not IsNumeric(sqlID) Then Exit Sub
      oUniFind.ShowBill "FD", oV.Name2Code(Left(xTemp, InStr(xTemp, "-") - 1)) + sqlID

'''''   Select Case iFindtype
'''''      Case 0      '银行贷款
'''''         Set fndCred = New clsCred
'''''         Set aTemp = fndCred
'''''         aTemp.BillListType = 1
'''''         aTemp.FindFlag = True
'''''         aTemp.FindString = sqlBillFind
'''''         aTemp.UnionFindflag = True
'''''         aTemp.UnionFindkey = "05" & sqlID
'''''         aTemp.Tag = "Cred" & UfGridADO1.hWnd
'''''         aTemp.Show
'''''
'''''      Case 1      '内部贷款
'''''         Set fndCred = New clsCred
'''''         Set aTemp = fndCred
'''''         aTemp.BillListType = 2
'''''         aTemp.FindFlag = True
'''''         aTemp.FindString = sqlBillFind
'''''         aTemp.UnionFindflag = True
'''''         aTemp.UnionFindkey = "06" & sqlID
'''''         aTemp.Tag = "Cred" & UfGridADO1.hWnd
'''''         aTemp.Show
'''''
'''''      Case 2      '银行还款
'''''         Set fndCredRet = New clsCredRet
'''''         Set aTemp = fndCredRet
'''''         aTemp.BillListType = 1
'''''         aTemp.FindFlag = True
'''''         aTemp.FindString = sqlBillFind
'''''         aTemp.UnionFindflag = True
'''''         aTemp.UnionFindkey = "08" & sqlID
'''''         aTemp.Tag = "CredRet" & UfGridADO1.hWnd
'''''         aTemp.Show
'''''
'''''      Case 3      '内部还款
'''''         Set fndCredRet = New clsCredRet
'''''         Set aTemp = fndCredRet
'''''         aTemp.BillListType = 2
'''''         aTemp.FindFlag = True
'''''         aTemp.FindString = sqlBillFind
'''''         aTemp.UnionFindflag = True
'''''         aTemp.UnionFindkey = "09" & sqlID
'''''         aTemp.Tag = "CredRet" & UfGridADO1.hWnd
'''''         aTemp.Show
'''''
'''''      Case 4     '银行还息
'''''         Set fndCredRet = New clsCredRet
'''''         Set aTemp = fndCredRet
'''''         aTemp.BillListType = 3
'''''         aTemp.FindFlag = True
'''''         aTemp.FindString = sqlBillFind
'''''         aTemp.UnionFindflag = True
'''''         aTemp.UnionFindkey = "10" & sqlID
'''''         aTemp.Tag = "CredRet" & UfGridADO1.hWnd
'''''         aTemp.Show
'''''
'''''      Case 5     '内部还息
'''''         Set fndCredRet = New clsCredRet
'''''         Set aTemp = fndCredRet
'''''         aTemp.BillListType = 4
'''''         aTemp.FindFlag = True
'''''         aTemp.FindString = sqlBillFind
'''''         aTemp.UnionFindflag = True
'''''         aTemp.UnionFindkey = "11" & sqlID
'''''         aTemp.Tag = "CredRet" & UfGridADO1.hWnd
'''''         aTemp.Show
'''''
'''''      Case 6      '内部拆借
'''''         Set fndLend = New clsLend
'''''         Set aTemp = fndLend
'''''         aTemp.FindFlag = True
'''''         aTemp.FindString = sqlBillFindPg
'''''         aTemp.UnionFindflag = True
'''''         aTemp.UnionFindkey = "07" & sqlID
'''''         aTemp.Tag = "Lend" & UfGridADO1.hWnd
'''''         aTemp.Show
'''''
'''''      Case 7     '拆借还款
'''''         Set fndLendRet = New clsLendRet
'''''         Set aTemp = fndLendRet
'''''         aTemp.BillListType = 1
'''''         aTemp.FindFlag = True
'''''         aTemp.FindString = sqlBillFindPg
'''''         aTemp.UnionFindflag = True
'''''         aTemp.UnionFindkey = "12" & sqlID
'''''         aTemp.Tag = "LendRet" & UfGridADO1.hWnd
'''''         aTemp.Show
'''''
'''''      Case 8     '拆借还息
'''''         Set fndLendRet = New clsLendRet
'''''         Set aTemp = fndLendRet
'''''         aTemp.BillListType = 2
'''''         aTemp.FindFlag = True
'''''         aTemp.FindString = sqlBillFindPg
'''''         aTemp.UnionFindflag = True
'''''         aTemp.UnionFindkey = "13" & sqlID
'''''         aTemp.Tag = "LendRet" & UfGridADO1.hWnd
'''''         aTemp.Show
'''''
'''''      Case 9     '利息单
'''''         Set fndCad = New clsCadBill
'''''         Set aTemp = fndCad
'''''         aTemp.FindFlag = True
'''''         aTemp.FindString = sqlBillFindPg
'''''         aTemp.UnionFindflag = True
'''''         aTemp.UnionFindkey = "16" & sqlID
'''''         aTemp.Tag = "Cad" & UfGridADO1.hWnd
'''''         aTemp.Show
'''''
'''''   End Select
   
End Sub