+-+

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

         "cAccID = '" & rsItemss!cCode & "' AND dbill_date <= '" & FormatDate(dSearchDate) & "' AND cBookCode IS NOT NULL "
      sqlCal = sqlCal & "UNION ALL SELECT Sum(-mmoney), 0, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then mmoney Else 0 End), 0, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then 1 Else 0 End) " & _
         "FROM FD_Return WHERE " & _
         "cAccID = '" & rsItemss!cCode & "' AND dbill_date <= '" & FormatDate(dSearchDate) & "' AND cBookCode IS NOT NULL "
      sqlCal = sqlCal & "UNION ALL SELECT Sum(-mmoney), 0, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then mmoney Else 0 End), 0, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then 1 Else 0 End) " & _
         "FROM FD_CreAcrRcp WHERE " & _
         "cAccID = '" & rsItemss!cCode & "' AND dbill_date <= '" & FormatDate(dSearchDate) & "' AND cBookCode IS NOT NULL "
      sqlCal = sqlCal & "UNION ALL SELECT Sum(mmoney), " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then mmoney Else 0 End), 0, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then 1 Else 0 End), 0 " & _
         "FROM FD_UnwDeb WHERE " & _
         "cGAccID = '" & rsItemss!cCode & "' AND dbill_date <= '" & FormatDate(dSearchDate) & "' AND cBookCode IS NOT NULL "
      sqlCal = sqlCal & "UNION ALL SELECT Sum(-mmoney), 0, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then mmoney Else 0 End), 0, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then 1 Else 0 End) " & _
         "FROM FD_UnwDeb WHERE " & _
         "cPAccID = '" & rsItemss!cCode & "' AND dbill_date <= '" & FormatDate(dSearchDate) & "' AND cBookCode IS NOT NULL "
      sqlCal = sqlCal & "UNION ALL SELECT Sum(mmoney), " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then mmoney Else 0 End), 0, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then 1 Else 0 End), 0 " & _
         "FROM FD_UnwRet WHERE " & _
         "cGAccID = '" & rsItemss!cCode & "' AND dbill_date <= '" & FormatDate(dSearchDate) & "' AND cBookCode IS NOT NULL "
      sqlCal = sqlCal & "UNION ALL SELECT Sum(-mmoney), 0, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then mmoney Else 0 End), 0, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then 1 Else 0 End) " & _
         "FROM FD_UnwRet WHERE " & _
         "cPAccID = '" & rsItemss!cCode & "' AND dbill_date <= '" & FormatDate(dSearchDate) & "' AND cBookCode IS NOT NULL "
      sqlCal = sqlCal & "UNION ALL SELECT Sum(mmoney), " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then mmoney Else 0 End), 0, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then 1 Else 0 End), 0 " & _
         "FROM FD_UnwAcrRcp WHERE " & _
         "cGAccID = '" & rsItemss!cCode & "' AND dbill_date <= '" & FormatDate(dSearchDate) & "' AND cBookCode IS NOT NULL "
      sqlCal = sqlCal & "UNION ALL SELECT Sum(-mmoney), 0, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then mmoney Else 0 End), 0, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then 1 Else 0 End) " & _
         "FROM FD_UnwAcrRcp WHERE " & _
         "cPAccID = '" & rsItemss!cCode & "' AND dbill_date <= '" & FormatDate(dSearchDate) & "' AND cBookCode IS NOT NULL "
      sqlCal = sqlCal & "UNION ALL SELECT Sum(mmoney), " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then mmoney Else 0 End), 0, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then 1 Else 0 End), 0 " & _
         "FROM FD_Sav WHERE " & _
         "cAccID = '" & rsItemss!cCode & "' AND dbill_date <= '" & FormatDate(dSearchDate) & "' AND cBookCode IS NOT NULL "
      sqlCal = sqlCal & "UNION ALL SELECT Sum(-mmoney), 0, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then mmoney Else 0 End), 0, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then 1 Else 0 End) " & _
         "FROM FD_Fetch WHERE " & _
         "cAccID = '" & rsItemss!cCode & "' AND dbill_date <= '" & FormatDate(dSearchDate) & "' AND cBookCode IS NOT NULL "
      sqlCal = sqlCal & "UNION ALL SELECT Sum(mmoney), " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then mmoney Else 0 End), 0, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then 1 Else 0 End), 0 " & _
         "FROM FD_SettAcc WHERE " & _
         "cGAccID = '" & rsItemss!cCode & "' AND dbill_date <= '" & _
         FormatDate(dSearchDate) & "' AND cBookCode IS NOT NULL AND Left(cSetID,2)='15' "
      sqlCal = sqlCal & "UNION ALL SELECT Sum(-mmoney), 0, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then mmoney Else 0 End), 0, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then 1 Else 0 End) " & _
         "FROM FD_SettAcc WHERE " & _
         "cPAccID = '" & rsItemss!cCode & "' AND dbill_date <= '" & _
         FormatDate(dSearchDate) & "' AND cBookCode IS NOT NULL AND Left(cSetID,2)='15' "
      
      sqlCal = sqlCal & "UNION ALL SELECT Sum(Case When igp_flag = 0 Then mmoney Else -mmoney End), " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then (Case When igp_flag = 0 Then mmoney Else 0 End) Else 0 End), Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then (Case When igp_flag = 0 Then 0 Else mmoney End) Else 0 End), " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then (Case When igp_flag = 0 Then 1 Else 0 End) Else 0 End), Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then (Case When igp_flag = 0 Then 0 Else 1 End) Else 0 End) " & _
         "FROM FD_SettAcc WHERE " & _
         "cGAccID = '" & rsItemss!cCode & "' AND dbill_date <= '" & _
         FormatDate(dSearchDate) & "' AND cBookCode IS NOT NULL AND Left(cSetID,2)='14' "
      sqlCal = sqlCal & "UNION ALL SELECT Sum(Case When igp_flag = 0 Then mmoney Else -mmoney End), " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then (Case When igp_flag = 0 Then mmoney Else 0 End) Else 0 End), Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then (Case When igp_flag = 0 Then 0 Else mmoney End) Else 0 End), " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then (Case When igp_flag = 0 Then 1 Else 0 End) Else 0 End), Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then (Case When igp_flag = 0 Then 0 Else 1 End) Else 0 End) " & _
         "FROM FD_SettAcc WHERE " & _
         "cPAccID = '" & rsItemss!cCode & "' AND dbill_date <= '" & _
         FormatDate(dSearchDate) & "' AND cBookCode IS NOT NULL AND Left(cSetID,2)='14' "
      
      sqlCal = sqlCal & "UNION ALL SELECT Sum(mmoney), " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then mmoney Else 0 End), 0, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then 1 Else 0 End), 0 " & _
         "FROM FD_CadAcr WHERE " & _
         "cGAccID = '" & rsItemss!cCode & "' AND dbill_date <= '" & FormatDate(dSearchDate) & "' AND iDanType=0 AND cBookCode IS NOT NULL "
      sqlCal = sqlCal & "UNION ALL SELECT Sum(-mmoney), 0, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then mmoney Else 0 End), 0, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then 1 Else 0 End) " & _
         "FROM FD_CadAcr WHERE " & _
         "cPAccID = '" & rsItemss!cCode & "' AND dbill_date <= '" & FormatDate(dSearchDate) & "' AND iDanType=0 AND cBookCode IS NOT NULL "
      sqlCal = sqlCal & "UNION ALL SELECT Sum(mb), 0, 0, 0, 0 " & _
         "FROM FD_AccDef WHERE " & _
         "cAccID = '" & rsItemss!cCode & "';"
      Set rsCal = dbsZJ.OpenRecordset(sqlCal, dbOpenSnapshot)
      cExch = GetzhExch(rsItemss!cCode)
      If ZjAccInfo.zjStandExch = cExch Then
         dblHl = 1
      Else
         dblHl = GetCurHl(cExch, zjLogInfo.curDate)
      End If
      With rsCal
         While Not .EOF
            m1 = m1 + IIf(IsNull(!todayMb), 0, !todayMb) * dblHl
            m2 = m2 + IIf(IsNull(!curMc), 0, !curMc) * dblHl
            m3 = m3 + IIf(IsNull(!CurMd), 0, !CurMd) * dblHl
            M4 = M4 + IIf(IsNull(!mInTemp), 0, !mInTemp)
            M5 = M5 + IIf(IsNull(!mOut), 0, !mOut)
            .MoveNext
         Wend
      End With
      rsItemss.MoveNext
   Wend
   With KhdtInfo
      .todayMb = m1
      .CurMd = m3
      .curMc = m2
      .mInTemp = M4
      .mOut = M5
      .preMb = .todayMb - (.CurMd - .curMc)
   End With
   
End Sub

'********************************************************************
'*函数说明: 计算从总账账户取数                                        *
'*参    数: iItem_id : 项目编号                                       *
'*                                                                   *
'*返回值  :                                                          *
'*********************************************************************
Private Sub Cal_KhdtZh(iItem_id As String)
   Dim sqlCale    As String
   Dim rsCale     As New UfRecordset
   Dim sqlItem    As String
   Dim rsItem     As New UfRecordset
   Dim bPropty    As Boolean
   Dim mQc        As Double
   Dim m1         As Double
   Dim m2         As Double
   Dim m3         As Double
   Dim M4         As Double
   Dim M5         As Double
   Dim lngZhPrp   As Long
   
   sqlItem = "SELECT * FROM FD_AccSet WHERE cAccID IN (SELECT " & _
      "ccode FROM FD_Itemss WHERE iitem_id=" & iItem_id & ")"
   Set rsItem = dbsZJ.OpenRecordset(sqlItem, dbOpenSnapshot)
   With rsItem
   While Not .EOF
      lngZhPrp = GetZhDir(!cAccID, !cCode)
      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, " & _
'         "Sum(IIf(dbill_date='" & FormatDate(dSearchDate) & "',md,0)) AS curMd, " & _
'         "Sum(IIf(dbill_date='" & FormatDate(dSearchDate) & "',mc,0)) AS curMc, " & _
'         "Sum(IIf(dbill_date='" & FormatDate(dSearchDate) & "',IIf(md=0,0,1),0)) AS mInTemp, " & _
'         "Sum(IIf(dbill_date='" & FormatDate(dSearchDate) & "',IIf(mc=0,0,1),0)) AS mOut " & _
'         "FROM GL_accVouch " & _
'         "WHERE ccode LIKE '" & !cCode & "%' AND iperiod >= 1 And iperiod <=12 AND " & _
'         "IIf(" & IsNull(!cdeptcode) & ", True, cdept_id LIKE '" & !cdeptcode & "%') AND " & _
'         "IIf(" & IsNull(!cPersonCode) & ", True, cperson_id = '" & !cPersonCode & "') AND " & _
'         "IIf(" & IsNull(!cCusCode) & ", True, ccus_id = '" & !cCusCode & "') AND " & _
'         "IIf(" & IsNull(!cSupCode) & ", True, csup_id = '" & !cSupCode & "') AND " & _
'         "IIf(" & IsNull(!cItem_id) & ", True, citem_id = '" & !cItem_id & "') AND " & _
'         "IIf(" & IsNull(!citem_class) & ", True, citem_class = '" & !citem_class & "') " & _
'         "AND iflag IS NULL AND dbill_date<='" & FormatDate(dSearchDate) & "'"
      
      sqlCale = "SELECT Sum(md-mc) AS todayMb, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then md Else 0 End) AS curMd, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then mc Else 0 End) AS curMc, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then (Case When md = 0 Then 0 Else 1 End) Else 0 End) AS mInTemp, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then (Case When mc = 0 Then 0 Else 1 End) Else 0 End) AS mOut " & _
         "FROM GL_accVouch " & _
         "WHERE ccode LIKE '" & !cCode & "%' AND iperiod >= 1 And iperiod <=12 " & _
         "AND iflag IS NULL AND dbill_date <= '" & FormatDate(dSearchDate) & "'"
      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)
      With rsCale
         If Not .EOF Then
            m1 = m1 + lngZhPrp * IIf(IsNull(!todayMb), 0, !todayMb)
            m2 = m2 + IIf(lngZhPrp = 1, IIf(IsNull(!curMc), 0, !curMc), IIf(IsNull(!CurMd), 0, !CurMd))
            m3 = m3 + IIf(lngZhPrp = 1, IIf(IsNull(!CurMd), 0, !CurMd), IIf(IsNull(!curMc), 0, !curMc))
            M4 = M4 + IIf(lngZhPrp = 1, IIf(IsNull(!mInTemp), 0, !mInTemp), IIf(IsNull(!mOut), 0, !mOut))
            M5 = M5 + IIf(lngZhPrp = 1, IIf(IsNull(!mOut), 0, !mOut), IIf(IsNull(!mInTemp), 0, !mInTemp))
         End If
      End With
      rsItem.MoveNext
   Wend
   End With
   With KhdtInfo
      .todayMb = mQc + m1
      .CurMd = m3
      .curMc = m2
      .mInTemp = M4
      .mOut = M5
      .preMb = .todayMb - (.CurMd - .curMc)
   End With
   
End Sub

'********************************************************************
'*函数说明: 计算从科目取数                                            *
'*参    数: iItem_id : 项目编号                                       *
'*                                                                   *
'*返回值  :                                                          *
'*********************************************************************
Private Sub Cal_KhdtKm(iItem_id As String)
   Dim sqlCale As String
   Dim rsCale As New UfRecordset
   Dim sqlItem As String
   Dim rsItem As New UfRecordset
   Dim blnPrpty As Boolean
   Dim mQc As Double
   Dim m1 As Double
   Dim m2 As Double
   Dim m3 As Double
   Dim M4 As Double
   Dim M5 As Double
   
   sqlItem = "SELECT ccode FROM FD_Itemss WHERE iitem_id=" & iItem_id
   Set rsItem = dbsZJ.OpenRecordset(sqlItem, dbOpenSnapshot)
   With rsItem
   While Not .EOF
      blnPrpty = GetKmPropty(!cCode)
      '---- Change DC Direction, 贷方为正(加贷减借)
      Dim curTmp  As Double
      
      curTmp = GetKmQC(!cCode, blnPrpty)
      mQc = mQc + IIf(blnPrpty, curTmp, -curTmp)

      '计算
      sqlCale = "SELECT Sum(md - mc) AS todayMb, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then md Else 0 End) AS curMd, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then mc Else 0 End) AS curMc, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then (Case When md = 0 Then 0 Else 1 End) Else 0 End) AS mOut, " & _
         "Sum(Case When dbill_date = '" & FormatDate(dSearchDate) & "' Then (Case When mc = 0 Then 0 Else 1 End) Else 0 End) AS mInTemp " & _
         "FROM GL_accVouch WHERE ccode LIKE '" & !cCode & _
         "%' AND iperiod >= 1 And iperiod <=12 AND iflag IS NULL AND dbill_date <= '" & FormatDate(dSearchDate) & "'"
      Set rsCale = dbsZJ.OpenRecordset(sqlCale, dbOpenSnapshot)
      With rsCale
      '---- Change DC Direction, 贷方为正(加贷减借)
         If Not .EOF Then
            m1 = m1 + IIf(IsNull(!todayMb), 0, IIf(blnPrpty, !todayMb, -!todayMb))
            m2 = m2 + IIf(Not blnPrpty, IIf(IsNull(!curMc), 0, !curMc), IIf(IsNull(!CurMd), 0, !CurMd))
            m3 = m3 + IIf(Not blnPrpty, IIf(IsNull(!CurMd), 0, !CurMd), IIf(IsNull(!curMc), 0, !curMc))
            M4 = M4 + IIf(Not blnPrpty, IIf(IsNull(!mInTemp), 0, !mInTemp), IIf(IsNull(!mOut), 0, !mOut))
            M5 = M5 + IIf(Not blnPrpty, IIf(IsNull(!mOut), 0, !mOut), IIf(IsNull(!mInTemp), 0, !mInTemp))
         End If
      End With
      rsItem.MoveNext
   Wend
   End With
   With KhdtInfo
      .todayMb = mQc + m1
      .CurMd = m3
      .curMc = m2
      .mInTemp = M4
      .mOut = M5
      .preMb = .todayMb - (.curMc - .CurMd)