帐户余额日报表.frm

财务信息管理系统,适合做毕业论文的人使用

   
   sqlItem = "SELECT * FROM FD_AccSet WHERE cAccID = '" & strAccID & "'"
   Set rsItem = dbsZJ.OpenRecordset(sqlItem, dbOpenSnapshot)
   strUnion = "": sqlX = ""
   With rsItem
   While Not .EOF
      lngZhPrp = GetZhDir(strAccID, !cCode)
      ZhDir = lngZhPrp
      bPropty = GetKmPropty(!cCode)
      If IsNull(!cdeptcode) And IsNull(!cPersonCode) And IsNull(!cCusCode) And IsNull(!cSupCode) And IsNull(!cItem_id) And IsNull(!citem_class) Then
         mQc = mQc + lngZhPrp * GetKmQC(!cCode, bPropty)
      Else
         mQc = mQc + lngZhPrp * GetKmQC_Fz(!cCode, bPropty, !cdeptcode, !cPersonCode, !cCusCode, !cSupCode, !cItem_id, !citem_class)
      End If
      
      sqlCale = "SELECT Sum(md-mc) AS todayMb " & _
         "FROM GL_accVouch " & _
         "WHERE ccode LIKE '" & !cCode & "%' AND iperiod >= 1 And iperiod <= 12 " & _
         "AND iflag IS NULL AND dbill_date< '" & FormatDate(datDate) & "'"
      If Not IsNull(!cdeptcode) Then
         sqlCale = sqlCale & " And cdept_id LIKE '" & !cdeptcode & "%'"
      End If
      If Not IsNull(!cPersonCode) Then
         sqlCale = sqlCale & " And cperson_id = '" & !cPersonCode & "'"
      End If
      If Not IsNull(!cCusCode) Then
         sqlCale = sqlCale & " And ccus_id = '" & !cCusCode & "'"
      End If
      If Not IsNull(!cSupCode) Then
         sqlCale = sqlCale & " And csup_id = '" & !cSupCode & "'"
      End If
      If Not IsNull(!cItem_id) Then
         sqlCale = sqlCale & " And citem_id = '" & !cItem_id & "'"
      End If
      If Not IsNull(!citem_class) Then
         sqlCale = sqlCale & " And citem_class = '" & !citem_class & "'"
      End If
         
      Set rsCale = dbsZJ.OpenRecordset(sqlCale, dbOpenSnapshot)
      mQc = mQc + IIf(IsNull(rsCale!todayMb), 0, lngZhPrp * rsCale!todayMb)
      
      sPropty = IIf(bPropty, "1 = 1", "1 = 0")
      sqlX = sqlX & strUnion & "SELECT csign AS Fieldx, " & _
         "iperiod AS Fieldy, " & _
         "ino_id AS Field0, " & _
         "cdigest AS Field1, " & _
         "ccode AS Field2, " & _
         "cperson_id AS Field3, " & _
         "cdept_id AS Field4, " & _
         "ccus_id AS Field5, " & _
         "csup_id AS Field6, " & _
         "citem_class AS Field7, " & _
         "md AS Field8, " & _
         "mc AS Field9, " & _
         "(Case When " & sPropty & " Then '借' Else '贷' End) AS Field10, " & _
         "citem_id AS Field11, " & _
         "iBook AS fColor " & _
         "FROM GL_accvouch " & _
         "WHERE ccode LIKE '" & !cCode & "%' AND iperiod >= 1 And iperiod <=12 And " & _
         "iflag IS NULL AND dbill_date = '" & FormatDate(datDate) & "'"
      If Not IsNull(!cdeptcode) Then
         sqlX = sqlX & " And cdept_id LIKE '" & !cdeptcode & "%'"
      End If
      If Not IsNull(!cPersonCode) Then
         sqlX = sqlX & " And cperson_id = '" & !cPersonCode & "'"
      End If
      If Not IsNull(!cCusCode) Then
         sqlX = sqlX & " And ccus_id = '" & !cCusCode & "'"
      End If
      If Not IsNull(!cSupCode) Then
         sqlX = sqlX & " And csup_id = '" & !cSupCode & "'"
      End If
      If Not IsNull(!cItem_id) Then
         sqlX = sqlX & " And citem_id = '" & !cItem_id & "'"
      End If
      If Not IsNull(!citem_class) Then
         sqlX = sqlX & " And citem_class = '" & !citem_class & "'"
      End If
         
      strUnion = " UNION ALL "
      rsItem.MoveNext
   Wend
   End With
   If InStr(1, sqlX, "UNION") <> 0 Then
      sqlX = sqlX & " ORDER BY Fieldy, Fieldx, Field0"
   Else
      sqlX = sqlX & " ORDER BY iperiod, csign, ino_id"
   End If
   Cal_Wbzh = mQc
End Function

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
   Shift = Shift And 7
   Select Case KeyCode
      Case vbKeyF4
          If Shift = vbCtrlMask And Toolbar1.Buttons("Exit").Enabled Then
              Gen_Key "Exit"
          ElseIf Shift = 0 Then
              Gen_Key "UnionFind"
          End If
      Case vbKeyP
          If Shift = vbCtrlMask And Toolbar1.Buttons("Print").Enabled Then
              Gen_Key "Print"
          End If
          KeyCode = 0
      Case vbKeyS
          'cuidong 2001.01.15
          'If Shift = vbCtrlMask And Toolbar1.Buttons("Preview").Enabled Then
          '    Gen_Key "Preview"
          'End If
          KeyCode = 0
      Case vbKeyW
          If Shift = vbCtrlMask And Toolbar1.Buttons("Dataout").Enabled Then
              Gen_Key "Dataout"
          End If
          KeyCode = 0
      Case vbKeyF
          If Shift = vbCtrlMask Then Gen_Key "Recx"
   End Select

End Sub

Private Sub InitLabel()
   Dim sqlX As String
   Dim rsX As New UfRecordset

   sqlX = "SELECT * FROM FD_AccDef WHERE cAccID='" & strAccID & "'"
   Set rsX = dbsZJ.OpenRecordset(sqlX, dbOpenSnapshot)
   If Not rsX.EOF Then
      Label2(0) = strAccID
      Label2(1) = rsX!cAccName
   End If
   Label1(1) = Year(datDate) & "年 " & Month(datDate) & "月 " & Day(datDate) & "日"
   Label1(2) = "账 户 号:"
   Label1(3) = "账户名称:"
End Sub

'********************************************************************
'*函数说明: 重新刷新窗体                                             *
'*参    数:                                                          *
'*                                                                   *
'*返回值  :                                                           *
'*********************************************************************
Public Sub RefreshMe()
   InitLabel
   GetDataSource strAccID
   PrepareData
   If Not rsDisplay.EOF Then rsDisplay.MoveLast
   nMaxRows = rsDisplay.RecordCount + 2
   initGrid False
   FillDisplayGrid
End Sub

Private Sub Form_Load()
    Me.Icon = LoadResPicture(109, vbResIcon)
   InitLabel
   ZhyeTlb Toolbar1, ImageList1
   Picture1.width = ZjAccInfo.zjPictWidth
   Picture1.Picture = LoadPicture(ZjAccInfo.zjRepPath & "BookBack.BMP")
   GetDataSource strAccID
   PrepareData
   nFixRows = 2
   If Not rsDisplay.EOF Then rsDisplay.MoveLast
   nMaxRows = rsDisplay.RecordCount + 2
   initGrid
   FillDisplayGrid
End Sub

Private Sub GetDataSource(strAccID As String)
   Dim rsDataSrc As New UfRecordset
   Set rsDataSrc = dbsZJ.OpenRecordset("SELECT * FROM FD_AccDef WHERE cAccID='" & strAccID & "'", dbOpenSnapshot)
   iDataSource = rsDataSrc!iDataSrc
   
End Sub

Private Function kmProperty(nAccID As String) As Boolean
   Dim sqlDc As String
   Dim rsDc As New UfRecordset
   
   sqlDc = "SELECT bProperty FROM code WHERE ccode IN (SELECT cCode FROM FD_AccSet " & _
      "WHERE cAccID = '" & nAccID & "')"
   Set rsDc = dbsZJ.OpenRecordset(sqlDc, dbOpenSnapshot)
   If Not rsDc.EOF Then
      kmProperty = IIf(IsNull(rsDc!bProperty), False, rsDc!bProperty)
   End If
      
End Function

Private Sub InitDataOut()
If iDataSource = 1 Then
      ReDim prnReport1(12)
      
      prnReport1(0).iColNumber = 0
      prnReport1(0).iColType = dbText
      prnReport1(0).cColName = UfGridADO1.TextMatrix(0, 0)
      prnReport1(0).iColLength = lngText
      
      prnReport1(1).iColNumber = 1
      prnReport1(1).iColType = dbText
      prnReport1(1).cColName = UfGridADO1.TextMatrix(0, 1)
      prnReport1(1).iColLength = lngText
      
      prnReport1(2).iColNumber = 2
      prnReport1(2).iColType = dbText
      prnReport1(2).cColName = UfGridADO1.TextMatrix(0, 2)
      prnReport1(2).iColLength = lngText
      
      prnReport1(3).iColNumber = 3
      prnReport1(3).iColType = dbText
      prnReport1(3).cColName = UfGridADO1.TextMatrix(1, 3)
      prnReport1(3).iColLength = lngText
      
      prnReport1(4).iColNumber = 4
      prnReport1(4).iColType = dbText
      prnReport1(4).cColName = UfGridADO1.TextMatrix(1, 4)
      prnReport1(4).iColLength = lngText
      
      prnReport1(5).iColNumber = 5
      prnReport1(5).iColType = dbText
      prnReport1(5).cColName = UfGridADO1.TextMatrix(1, 5)
      prnReport1(5).iColLength = lngText
      
      prnReport1(6).iColNumber = 6
      prnReport1(6).iColType = dbText
      prnReport1(6).cColName = UfGridADO1.TextMatrix(1, 6)
      prnReport1(6).iColLength = lngText
      
      prnReport1(7).iColNumber = 7
      prnReport1(7).iColType = dbText
      prnReport1(7).cColName = UfGridADO1.TextMatrix(1, 7)
      prnReport1(7).iColLength = lngText
      
      prnReport1(8).iColNumber = 8
      prnReport1(8).iColType = dbCurrency
      prnReport1(8).cColName = UfGridADO1.TextMatrix(0, 8)
      prnReport1(8).iColLength = lngCurrency
      
      prnReport1(9).iColNumber = 9
      prnReport1(9).iColType = dbCurrency
      prnReport1(9).cColName = UfGridADO1.TextMatrix(0, 9)
      prnReport1(9).iColLength = lngCurrency
      
      prnReport1(10).iColNumber = 10
      prnReport1(10).iColType = dbLong
      prnReport1(10).cColName = UfGridADO1.TextMatrix(0, 10)
      prnReport1(10).iColLength = lngText
      
      prnReport1(11).iColNumber = 11
      prnReport1(11).iColType = dbCurrency
      prnReport1(11).cColName = UfGridADO1.TextMatrix(0, 11)
      prnReport1(11).iColLength = lngCurrency
   Else
      ReDim prnReport1(5)
      
      prnReport1(0).iColNumber = 0
      prnReport1(0).iColType = dbText
      prnReport1(0).cColName = UfGridADO1.TextMatrix(0, 0)
      prnReport1(0).iColLength = lngText
      
      prnReport1(1).iColNumber = 1
      prnReport1(1).iColType = dbText
      prnReport1(1).cColName = UfGridADO1.TextMatrix(0, 1)
      prnReport1(1).iColLength = lngText
      
      prnReport1(2).iColNumber = 2
      prnReport1(2).iColType = dbCurrency
      prnReport1(2).cColName = UfGridADO1.TextMatrix(0, 2)
      prnReport1(2).iColLength = lngCurrency
      
      prnReport1(3).iColNumber = 3
      prnReport1(3).iColType = dbCurrency
      prnReport1(3).cColName = UfGridADO1.TextMatrix(0, 3)
      prnReport1(3).iColLength = lngCurrency
      
      prnReport1(4).iColNumber = 4
      prnReport1(4).iColType = dbCurrency
      prnReport1(4).cColName = UfGridADO1.TextMatrix(0, 4)
      prnReport1(4).iColLength = lngCurrency
   End If
End Sub

Private Sub initGrid(Optional vRefresh As Variant)
   Dim i As Long
   Dim strTemp As String
   
   With UfGridADO1
      If iDataSource = 1 Then
         '设置UFGRID，将其作为数据显示区(0)
'         .Redraw = True
         .LargeVirtualGrid = False
         .Rows = 0
         .Cols = 0
         .Rows = nFixRows
         .FixedRows = nFixRows
         .Cols = 13
         .FixedCols = 0
         
         .ColWidth(0) = 700
         .ColWidth(1) = 2000
         .ColWidth(2) = 1000
         .ColWidth(3) = 0
         .ColWidth(4) = 1000
         .ColWidth(5) = 1000
         .ColWidth(6) = 1000
         .ColWidth(7) = 1000
         .ColWidth(8) = 1000
         .ColWidth(9) = 1200
         .ColWidth(10) = 1200
         .ColWidth(11) = 350
         .ColWidth(12) = 1200
         
         '初始化表头及对齐方式
         .TextMatrix(0, 0) = "凭证号"
         .TextMatrix(1, 0) = "凭证号"
         .JoinCells 0, 0, 1, 0, True
         .ColAlignment(0) = UG_ALIGNCENTER
         
         .TextMatrix(0, 1) = "摘   要"
         .TextMatrix(1, 1) = "摘   要"
         .JoinCells 0, 1, 1, 1, True
         .ColAlignment(1) = UG_ALIGNLEFT
         
         .TextMatrix(0, 2) = "科目编码"
         .TextMatrix(1, 2) = "科目编码"
         .JoinCells 0, 2, 1, 2, True
         .ColAlignment(2) = UG_ALIGNLEFT
         
         .TextMatrix(1, 3) = "业务ID"
         
         .TextMatrix(1, 4) = "个人名称"
         .TextMatrix(1, 5) = "部门名称"
         .TextMatrix(1, 6) = "客户名称"
         .TextMatrix(1, 7) = "供应商名称"
         .TextMatrix(1, 8) = "项目名称"
         .JoinCells 1, 4, 1, 8, False  'cuidong 2000/11/15
         .JoinCells 1, 5, 1, 8, False  'cuidong 2000/11/15
         
         .TextMatrix(0, 4) = "辅助账类"
         .TextMatrix(0, 5) = "辅助账类"
         .TextMatrix(0, 6) = "辅助账类"
         .TextMatrix(0, 7) = "辅助账类"
         .TextMatrix(0, 8) = "辅助账类"
         .JoinCells 0, 4, 0, 8, True
         For i = 4 To 8
            .ColAlignment(i) = UG_ALIGNLEFT
         Next i
         
         .TextMatrix(0, 9) = "借方"
         .TextMatrix(1, 9) = "借方"
         .JoinCells 0, 9, 1, 9, True