对帐单.frm

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

         IIf(IsNull(!cdeptcode), " 1=1 ", " [cdept_id] LIKE '" & !cdeptcode & "%'") + " AND " & _
         IIf(IsNull(!cPersonCode), " 1=1 ", " [cperson_id] = '" & !cPersonCode & "'") + " AND " & _
         IIf(IsNull(!cCusCode), " 1=1 ", " [ccus_id] = '" & !cCusCode & "'") + " AND " & _
         IIf(IsNull(!cSupCode), " 1=1 ", " [csup_id] = '" & !cSupCode & "'") + " AND " & _
         IIf(IsNull(!cItem_id), " 1=1 ", " [citem_id] = '" & !cItem_id & "'") + " AND " & _
         IIf(IsNull(!citem_class), " 1=1 ", " [citem_class] = '" & !citem_class & "'") & _
         "AND [iflag] IS NULL AND [dbill_date] >= '" & FormatDate(datFrom) & "' AND [dbill_date] <= '" & _
         FormatDate(datTo) & "'" 'cuidong 2001.11.30
' sqlX = sqlX & strUnion & "SELECT [csign] AS Fieldx, " & _
         "[iperiod] AS Fieldy, [ibook] AS fColor, " & _
         "Year([dbill_date]) AS Field0, " & _
         "Month([dbill_date]) AS Field1, " & _
         "Day([dbill_date]) AS Field2, " & _
         "[ino_id] AS Field3, " & _
         "[cdigest] AS Field4, " & _
         "[md] AS Field5, " & _
         "[mc] AS Field6, " & _
         IIf(ZhDir = 1, " '借' ", " '贷' ") + " AS Field7 " & _
         "FROM GL_accvouch " & _
         "WHERE [ccode] LIKE '" & ![cCode] & "%' AND iperiod >= 1 And iperiod <=12 AND " & _
         IIf(IsNull(!cdeptcode), " 1=1 ", " [cdept_id] LIKE '" & !cdeptcode & "%'") + " AND " & _
         IIf(IsNull(!cPersonCode), " 1=1 ", " [cperson_id] = '" & !cPersonCode & "'") + " AND " & _
         IIf(IsNull(!cCusCode), " 1=1 ", " [ccus_id] = '" & !cCusCode & "'") + " AND " & _
         IIf(IsNull(!cSupCode), " 1=1 ", " [csup_id] = '" & !cSupCode & "'") + " AND " & _
         IIf(IsNull(!cItem_id), " 1=1 ", " [citem_id] = '" & !cItem_id & "'") + " AND " & _
         IIf(IsNull(!citem_class), " 1=1 ", " [citem_class] = '" & !citem_class & "'") & _
         "AND [iflag] IS NULL AND [dbill_date] >= '" & FormatDate(datFrom) & "' AND [dbill_date] <= '" & _
         FormatDate(datTo) & "'" 'cuidong 对账单+外币 2001.12.04 'cuidong 2001.11.30
       sqlX = sqlX & strUnion & "SELECT [csign] AS Fieldx, " & _
         "[iperiod] AS Fieldy, [ibook] AS fColor, " & _
         "Year([dbill_date]) AS Field0, " & _
         "Month([dbill_date]) AS Field1, " & _
         "Day([dbill_date]) AS Field2, " & _
         "[ino_id] AS Field3, " & _
         "[cdigest] AS Field4, " & _
         "[md] AS Field5, " & _
         "[md_f] AS Field5_f, " & _
         "[mc] AS Field6, " & _
         "[mc_f] AS Field6_f, " & _
         IIf(ZhDir = 1, " '借' ", " '贷' ") + " AS Field7 " & _
         "FROM GL_accvouch " & _
         "WHERE [ccode] LIKE '" & ![cCode] & "%' AND iperiod >= 1 And iperiod <=12 AND " & _
         IIf(IsNull(!cdeptcode), " 1=1 ", " [cdept_id] LIKE '" & !cdeptcode & "%'") + " AND " & _
         IIf(IsNull(!cPersonCode), " 1=1 ", " [cperson_id] = '" & !cPersonCode & "'") + " AND " & _
         IIf(IsNull(!cCusCode), " 1=1 ", " [ccus_id] = '" & !cCusCode & "'") + " AND " & _
         IIf(IsNull(!cSupCode), " 1=1 ", " [csup_id] = '" & !cSupCode & "'") + " AND " & _
         IIf(IsNull(!cItem_id), " 1=1 ", " [citem_id] = '" & !cItem_id & "'") + " AND " & _
         IIf(IsNull(!citem_class), " 1=1 ", " [citem_class] = '" & !citem_class & "'") & _
         "AND [iflag] IS NULL AND [dbill_date] >= '" & FormatDate(datFrom) & "' AND [dbill_date] <= '" & _
         FormatDate(datTo) & "'" 'cuidong 对账单+外币 2001.12.04 'cuidong 2001.11.30
         'ZhDir
      strUnion = " UNION ALL "
      rsItem.MoveNext
   Wend
   End With
   If InStr(1, sqlX, "UNION") <> 0 Then
      sqlX = sqlX & " ORDER BY [Field0], [Field1], [Field2], [Fieldx], [Field3]"
   Else
      sqlX = sqlX & " ORDER BY [dbill_date], [csign], [ino_id]"
   End If
   Cal_Wbzh = mQc
End Function


'Private Sub Form_Click()
'   If Text1.Visible = True Then
'      SavUnit
'   End If
'
'End Sub
'
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
   Shift = Shift And 7
   Select Case KeyCode
      Case vbKeyF3
          If Shift = 0 Then
              Gen_Key "Item"
          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 vbKeyR
          If Shift = vbCtrlMask And Toolbar1.Buttons("Prints").Enabled Then
              Gen_Key "Prints"
          End If
          KeyCode = 0
      Case vbKeyF4
          If Shift = vbCtrlMask And Toolbar1.Buttons("Exit").Enabled Then
              Gen_Key "Exit"
          End If
          KeyCode = 0
      Case vbKeyF
          If Shift = vbCtrlMask Then Gen_Key "Recx"
   End Select
End Sub

Private Sub Form_Load()
   Dim sqlX As String
   Dim rsX As New UfRecordset
   Screen.MousePointer = vbHourglass
   Me.Icon = LoadResPicture(109, vbResIcon)
   DzdTlb Toolbar1, ImageList1
   Picture1.width = ZjAccInfo.zjPictWidth
   Picture2.width = ZjAccInfo.zjPictWidth
   Picture1.Picture = LoadPicture(ZjAccInfo.zjRepPath & "BookBack.BMP")
   Picture2.Picture = LoadPicture(ZjAccInfo.zjRepPath & "BookBack.BMP")
   RefreshMe
   RTPrn1.lngrtpBodyRows = LinesPerPage + 2
   Picture1.top = Toolbar1.Height + 100
   UfGridADO1.top = Toolbar1.Height + Picture1.Height + 100
   Label2(0).top = Label1(2).top
   Label2(1).top = Label1(3).top
   Screen.MousePointer = vbDefault
End Sub

'********************************************************************
'*函数说明: 重新刷新窗体                                             *
'*参    数:                                                          *
'*                                                                   *
'*返回值  :                                                           *
'*********************************************************************
Public Sub RefreshMe()
'   Dim oAcc    As UsFDSet.CAccount       'Cuidong 2000/08/10
   Dim oOption As COption
   
   LinesPerPage = 10
   
   Set oOption = New COption
   oOption.Init dbsZJ
   LinesPerPage = oOption.DzdRows

'   Set oAcc = New UsFDSet.CAccount       'Cuidong 2000/08/10
'   oAcc.Init dbsZJ.DbConnect, , strAccID 'Cuidong 2000/08/10
'   lblAccBank = "开户银行:" & IIf(oAcc.sAccBank = "", Space(10), oAcc.sAccBank) 'Cuidong 2000/08/10
'   Label2(0) = oAcc.id                   'Cuidong 2000/08/10
'   Label2(1) = oAcc.Name                 'Cuidong 2000/08/10
          
   Dim RsAccDef As New UfRecordset        'Cuidong 2000/08/10
   Set RsAccDef = dbsZJ.OpenRecordset("Select cAccID, cAccName, cAccBank From FD_AccDef Where cAccID = '" & strAccID & "'") 'Cuidong 2000/08/10
   With RsAccDef                          'Cuidong 2000/08/10
       If Not (.EOF Or .BOF) Then         'Cuidong 2000/08/10
          lblAccBank = "开户银行:" & IIf(IsNull(.Fields!cAccBank), Space(10), .Fields!cAccBank)  'Cuidong 2000/08/10
          Label2(0) = IIf(IsNull(.Fields!cAccId), "", .Fields!cAccId)     'Cuidong 2000/08/10
          Label2(1) = IIf(IsNull(.Fields!cAccName), "", .Fields!cAccName) 'Cuidong 2000/08/10
          
       Else                              'Cuidong 2000/08/10
          lblAccBank = "开户银行:" & Space(10) 'Cuidong 2000/08/10
          Label2(0) = ""                 'Cuidong 2000/08/10
          Label2(1) = ""                 'Cuidong 2000/08/10
          
       End If                            'Cuidong 2000/08/10
       .oClose                           'Cuidong 2000/08/10
   End With                              'Cuidong 2000/08/10
   
   Label2(5) = zjLogInfo.cUserName
   
   nFixRows = 2
   Label2(2) = lngPageFrom
   GetDateFromTo
   GetDataSource strAccID
   
   PrepareData strAccID, rsDisplay
   initGrid
   If rsDisplay.EOF Then
      nMaxRows = 0
   Else
      rsDisplay.MoveLast
      nMaxRows = rsDisplay.RecordCount
      If lngPageTo = -1 Then
          lngPageTo = nMaxRows \ LinesPerPage
          If nMaxRows Mod LinesPerPage <> 0 Then
            lngPageTo = lngPageTo + 1
          End If
      End If
      nMaxRows = rsDisplay.RecordCount - (lngPageFrom - 1) * LinesPerPage
      If nMaxRows > (lngPageTo - lngPageFrom + 1) * LinesPerPage Then
         nMaxRows = (lngPageTo - lngPageFrom) * LinesPerPage + (nMaxRows Mod LinesPerPage)
      End If
      If nMaxRows > 0 Then                  'cuidong 2001.04.11
         FillDisplayGrid strAccID, rsDisplay, lngPageFrom, lngPageTo
      End If                                'cuidong 2001.04.11
   End If
      
   Form_Resize
'   Set oAcc = Nothing                      'Cuidong 2000/08/10
   Set RsAccDef = Nothing                   'Cuidong 2000/08/10
   Set oOption = Nothing
End Sub

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

Private Sub GetDateFromTo()
   Dim iX As Integer
   
'   datFrom = CDate(Year(zjLogInfo.curDate) & "-" & lngMonth & "-1")
   datFrom = CDate(lngYear & "-" & lngMonth & "-1")
   On Error GoTo ErrL
   iX = 31
'   datTo = CDate(Year(zjLogInfo.curDate) & "-" & lngMonth & "-" & iX)
   datTo = CDate(lngYear & "-" & lngMonth & "-" & iX)
   Exit Sub
   
ErrL:
   iX = iX - 1
   Resume
   
End Sub

Private Function kmProperty(nAccID As String) As Boolean
      Dim sqlDc As String, 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 initGrid()
   Dim i As Long, strTemp As String
   
   With UfGridADO1
      '设置UFGRID，将其作为数据显示区(0)
      .Redraw = True
      .LargeVirtualGrid = True
      .Rows = nFixRows
      .FixedRows = nFixRows
'      .Cols = IIf(iDataSource = 1, 9, 8)        'cuidong 对账单+外币 2001.12.04
      .Cols = IIf(iDataSource = 1, 10 + 3, 9 + 2) 'cuidong 对账单+外币 2001.12.04
      .FixedCols = 3
      .ColWidth(0) = 450
      For i = 1 To 2
        .ColWidth(i) = 300
      Next i
      .ColWidth(3) = 1700
      .ColWidth(4) = 0
      .ColWidth(5) = 2500
      .ColWidth(6) = 1800
      .ColWidth(7) = 1800
      .ColWidth(8) = 1800 'cuidong 对账单+外币 2001.12.04
      .ColWidth(9) = 1800 'cuidong 对账单+外币 2001.12.04