凭证查询.frm

u8

         !bcodeedit = False         'rsGlVouch!bcodeedit
         !ccodecontrol = rsGlVouch!ccodecontrol
         !bPCSedit = False          'rsGlVouch!bpcsedit
         !bDeptedit = False         'rsGlVouch!bdeptedit
         !bItemedit = False         'rsGlVouch!bitemedit
         !bCusSupInput = False      'rsGlVouch!bcussupinput
         .Update
      End With
      rsGlVouch.MoveNext
   Wend
   
   '---- 制单
   DoPzzd
   
   '---- 解锁
   LockVouchForCX False
   
   '---- 填充 Grid
   fillgrid
End Sub

'********************************************************************
'*函数说明: 凭证审核检查                                             *
'*参    数:                                                          *
'*                                                                   *
'*返回值  : True : 已审核                                             *
'*********************************************************************
Private Function IsVouchCheck() As Boolean
   Dim sqlGl As String
   Dim rsGl As New UfRecordset
   
   sqlGl = "SELECT [ccheck] FROM GL_accvouch WHERE [coutno_id] = '" & strID(UfGridADO1.Row - 2) & "'"
   Set rsGl = dbsZJ.OpenRecordset(sqlGl, dbOpenSnapshot)
   If Not rsGl.EOF Then
      IsVouchCheck = IIf(IsNull(rsGl![ccheck]), False, True)
   End If

End Function

Private Function GetDelID() As String
   Dim sqlGl As String
   Dim rsGl As New UfRecordset
   Dim rNo As Long
   Dim oNo As Long
   
   sqlGl = "SELECT [coutno_id] FROM GL_accvouch WHERE [coutno_id] LIKE '" & strID(UfGridADO1.Row - 2) & _
      "-%' ORDER BY [coutno_id]"
   Set rsGl = dbsZJ.OpenRecordset(sqlGl, dbOpenSnapshot)
   If rsGl.EOF Then
      GetDelID = strID(UfGridADO1.Row - 2) & "-1"
   Else
      oNo = 0
      While Not rsGl.EOF
         rNo = right(rsGl![coutno_id], Len(rsGl![coutno_id]) - InStr(1, rsGl![coutno_id], "-")) + 1
         If oNo < rNo Then
            GetDelID = strID(UfGridADO1.Row - 2) & "-" & rNo
            oNo = rNo
         End If
         rsGl.MoveNext
      Wend
   End If
End Function

'********************************************************************
'*函数说明: 凭证删除                                                 *
'*参    数:                                                          *
'*                                                                   *
'*返回值  :                                                          *
'*********************************************************************
Private Sub DeleteVouch()
   Dim sqlGlVouch As String
   Dim sqlFdVouch As String
   Dim cDelID     As String
   Dim blnCheck   As Boolean
   Dim rsGlVouch  As New UfRecordset
   
   '---- 无记录
   If UfGridADO1.Row < 2 Then Exit Sub
   If MsgBox("作废凭证将不能再恢复，继续吗?", vbQuestion + vbYesNo, zjGl_Name) = vbNo Then Exit Sub
   
   '---- 取得凭证号
   sqlGlVouch = "Select iperiod, csign, ino_id From GL_accvouch Where [coutno_id]='" & strID(UfGridADO1.Row - 2) & "'"
   Set rsGlVouch = dbsZJ.OpenRecordset(sqlGlVouch, dbOpenSnapshot)
   If rsGlVouch.EOF Then Exit Sub
   
   '                           期间                  类别              凭证号           功能号
   If aClsPub.LockOldVouch(rsGlVouch!iPeriod, rsGlVouch!cSign, rsGlVouch!iNo_id, "FD0505") Then
      blnCheck = IsVouchCheck
      If blnCheck Then
        '**********　凭证解锁
         Call aClsPub.unLockVouch(rsGlVouch!iPeriod, rsGlVouch!cSign, rsGlVouch!iNo_id, False)
         MsgBox "本张凭证已经审核，不能作废！", vbInformation, zjGl_Name
         Exit Sub
      End If
      
      If zjLogInfo.TaskExec("SYSLOCK4", True) Then
            On Error Resume Next
            dbsZJ.BeginTrans
            
            cDelID = GetDelID
            
            '---- 作废凭证 ----
            sqlGlVouch = "UPDATE GL_accvouch SET [iflag]=1, [coutno_id]='" & cDelID & "' WHERE [coutsysname]='FD' AND " & _
               "[coutno_id]='" & strID(UfGridADO1.Row - 2) & "' AND [iflag] IS NULL"
            dbsZJ.Execute sqlGlVouch, dbFailOnError
            
            '---- 对应修改资金关联项 ----
            sqlFdVouch = "DELETE  FROM FD_Vouch WHERE [cBus_id]='" & strID(UfGridADO1.Row - 2) & "'"
            dbsZJ.Execute sqlFdVouch, dbFailOnError
            
            If Err.Number = 0 Then
               dbsZJ.CommitTrans
               UfGridADO1.TextMatrix(UfGridADO1.Row, 9) = bFlag
               UfGridADO1.col = IIf(UfGridADO1.col < 5, 5, 3)
            Else
                dbsZJ.Rollback
            End If
            On Error GoTo 0
            Call zjLogInfo.TaskExec("SYSLOCK4", False)
       Else
            MsgBox "网络上有其他人正在保存凭证，请稍候再试......", vbInformation, zjGl_Name
       End If
   End If
   '**********　凭证解锁
   Call aClsPub.unLockVouch(rsGlVouch!iPeriod, rsGlVouch!cSign, rsGlVouch!iNo_id, False)
   '                           期间               类别             凭证号       必须为False
   CloseRS rsGlVouch
End Sub

'********************************************************************
'*函数说明: 凭证处理                                                 *
'*参    数: mJobType : pzStyle(处理方式)                             *
'*                                                                   *
'*返回值  :                                                          *
'*********************************************************************
Private Sub DoPzJob(mJobType As pzStyle)
   Dim sqlT As String
   Dim Rst As New UfRecordset
   
   If UfGridADO1.Row < 2 Or UfGridADO1.TextMatrix(UfGridADO1.Row, 9) <> "" Then Exit Sub
'   sqlT = "SELECT [ioutperiod],[coutsign],[coutno_id] FROM GL_accvouch WHERE " & _
      "[coutno_id]='" & strID(UfGridADO1.Row - 2) & "' AND [iflag] IS NULL AND [dbill_date]='" & FormatDate(UfGridADO1.TextMatrix(UfGridADO1.Row, 4)) & "'"
   sqlT = "SELECT [ioutperiod],[coutsign],[coutno_id] FROM GL_accvouch WHERE " & _
      "[coutno_id]='" & strID(UfGridADO1.Row - 2) & "' AND (([iflag] IS NULL) or ([iFlag] = 2)) AND [dbill_date]='" & FormatDate(UfGridADO1.TextMatrix(UfGridADO1.Row, 5)) & "'"
   Set Rst = dbsZJ.OpenRecordset(sqlT, dbOpenSnapshot)
   InitPzControl
   aClsPz.StartUpPz "FD", "FD0505", mJobType, "CN", "FD", Rst![ioutperiod], Rst![coutsign], Rst![coutno_id]
End Sub

Private Sub UfGridado1_DBClick(ByVal nRow As Long, ByVal nCol As Long)
   If Not UfGridADO1.CellForeColor(nRow, 0) = &H0& Then Exit Sub '红字凭证 'Cuidong 2000/08/03

   DoPzJob Pz_LC
   
End Sub

'********************************************************************
'*函数说明: 凭证制单                                                 *
'*参    数:                                                          *
'*                                                                   *
'*返回值  :                                                          *
'*********************************************************************
Private Sub DoPzzd()
    InitPzControl
    aClsPz.StartUpPz "FD", "FD0505", Pz_ZD, "CN"
End Sub

'********************************************************************
'*函数说明: 检查凭证冲销                                             *
'*参    数:                                                          *
'*                                                                   *
'*返回值  :                                                          *
'*********************************************************************
Private Function CheckChX() As Boolean
   Dim sqlGlVouch As String
   Dim rsGlVouch As New UfRecordset
   Dim dblMd As Double
   
   sqlGlVouch = "SELECT [md] FROM GL_accvouch WHERE [coutno_id]='" & _
      strID(UfGridADO1.Row - 2) & "' AND [iflag] IS NULL ORDER BY [md]"
   Set rsGlVouch = dbsZJ.OpenRecordset(sqlGlVouch, dbOpenSnapshot)
   If Not rsGlVouch.EOF Then
      rsGlVouch.MoveLast
      If rsGlVouch.RecordCount Mod 2 = 1 Then CheckChX = False: Exit Function
      dblMd = rsGlVouch![md]
      rsGlVouch.MoveFirst
      If rsGlVouch![md] + dblMd = 0 And Abs(rsGlVouch![md]) = Abs(dblMd) Then
         CheckChX = True
      Else
         CheckChX = False
      End If
   End If

End Function

'********************************************************************
'*函数说明: 检查凭证记账                                             *
'*参    数:                                                          *
'*                                                                   *
'*返回值  :                                                          *
'*********************************************************************
Private Function CheckBook() As Boolean
   Dim sqlGlVouch As String
   Dim rsGlVouch As New UfRecordset
   Dim iRow As Integer
   iRow = UfGridADO1.Row
   sqlGlVouch = "SELECT [cbook] FROM GL_accvouch WHERE [coutno_id]='" & strID(UfGridADO1.Row - 2) & "' AND [dbill_date]='" & FormatDate(UfGridADO1.TextMatrix(UfGridADO1.Row, 5)) & "' AND [iflag] IS NULL"
   Set rsGlVouch = dbsZJ.OpenRecordset(sqlGlVouch, dbOpenSnapshot)
   If Not rsGlVouch.EOF Then
      CheckBook = IIf(IsNull(rsGlVouch![cbook]), False, True)
   End If
   
End Function

Private Sub ufgridado1_RowColChange(ByVal nOldRow As Long, ByVal nOldCol As Long, ByVal nNewRow As Long, ByVal nNewCol As Long)
   If nNewRow < 2 Then Exit Sub
   With tlbAction
      If Not UfGridADO1.TextMatrix(nNewRow, 10) = "" Then    'Cuidong 2000.12.25
         '标错                                                'Cuidong 2000.12.25
         .Buttons("Modify").Enabled = False                   'Cuidong 2000.12.25
         .Buttons("PingZheng").Enabled = True                'Cuidong 2000.12.25
         .Buttons("UnionFind").Enabled = True                'Cuidong 2000.12.25
         .Buttons("ChongXiao").Enabled = False                'Cuidong 2000.12.25
         .Buttons("Delete").Enabled = False                   'Cuidong 2000.12.25
      Else                                                    'Cuidong 2000.12.25
         '正常凭证                                            'Cuidong 2000/08/14
         .Buttons("Modify").Enabled = True                    'Cuidong 2000/08/14
         .Buttons("UnionFind").Enabled = True                 'Cuidong 2000/08/14
         .Buttons("PingZheng").Enabled = True                 'Cuidong 2000/08/14
         If CheckBook Then                                    'Cuidong 2000/08/14
            .Buttons("ChongXiao").Enabled = True              'Cuidong 2000/08/14
            .Buttons("Delete").Enabled = False                'Cuidong 2000/08/16
         Else                                                 'Cuidong 2000/08/14
            .Buttons("ChongXiao").Enabled = False             'Cuidong 2000/08/14
            .Buttons("Delete").Enabled = True                 'Cuidong 2000/08/16
         End If                                               'Cuidong 2000/08/14
         If Trim(UfGridADO1.TextMatrix(UfGridADO1.Row, 9)) <> "" Then
            .Buttons("Delete").Enabled = False                'Cuidong 2000/08/14
         End If
      End If                                                  'Cuidong 2000.12.25
'      If CheckBook Then                        'Cuidong 2000/08/16
''         .Buttons("ChongXiao").Enabled = True 'Cuidong 2000/08/16
'         .Buttons("Delete").Enabled = False    'Cuidong 2000/08/16
'      Else                                     'Cuidong 2000/08/16
'         .Buttons("ChongXiao").Enabled = False 'Cuidong 2000/08/16
'         .Buttons("Delete").Enabled = True     'Cuidong 2000/08/16
'      End If                                   'Cuidong 2000/08/16
'      If UfGridADO1.TextMatrix(UfGridADO1.Row, 8) <> "" Then .Buttons("Delete").Enabled = False      'Cuidong 2000/08/14
'      If Trim(UfGridADO1.TextMatrix(UfGridADO1.Row, 8)) <> "" Then .Buttons("Delete").Enabled = False 'Cuidong 2000/08/14
   End With

End Sub

'Private Sub UfGridado1_RowColChange(ByVal nOldRow As Long, ByVal nOldCol As Long, ByVal nNewRow As Long, ByVal nNewCol As Long)
'   If nNewRow < 2 Then Exit Sub
'   With tlbAction
'      If Not UfGridADO1.TextMatrix(nNewRow, 9) = "" Then    'Cuidong 2000.12.25
'         '标错                                                'Cuidong 2000.12.25
'         .Buttons("Modify").Enabled = False                   'Cuidong 2000.12.25
'         .Buttons("PingZheng").Enabled = True                'Cuidong 2000.12.25
'         .Buttons("UnionFind").Enabled = True                'Cuidong 2000.12.25
'         .Buttons("ChongXiao").Enabled = False                'Cuidong 2000.12.25
'         .Buttons("Delete").Enabled = False                   'Cuidong 2000.12.25
'      Else                                                    'Cuidong 2000.12.25
'         If Not UfGridADO1.CellForeColor(nNewRow, 0) = &H0& Then 'Cuidong 2000/08/14
'            '冲销凭证                                            'Cuidong 2000/08/14
'            .Buttons("Modify").Enabled = False                   'Cuidong 2000/08/14
'            .Buttons("UnionFind").Enabled = False                'Cuidong 2000/08/14
'            .Buttons("PingZheng").Enabled = False                'Cuidong 2000/08/14
'            .Buttons("ChongXiao").Enabled = False                'Cuidong 2000/08/14
'            .Buttons("Delete").Enabled = False                   'Cuidong 2000/08/14
'         Else                                                    'Cuidong 2000/08/14
'            '正常凭证                                            'Cuidong 2000/08/14
'            .Buttons("Modify").Enabled = True                    'Cuidong 2000/08/14
'            .Buttons("UnionFind").Enabled = True                 'Cuidong 2000/08/14
'            .Buttons("PingZheng").Enabled = True                 'Cuidong 2000/08/14
'            If CheckBook Then                                    'Cuidong 2000/08/14
'               .Buttons("ChongXiao").Enabled = True              'Cuidong 2000/08/14
'               .Buttons("Delete").Enabled = False                'Cuidong 2000/08/16
'            Else                                                 'Cuidong 2000/08/14
'               .Buttons("ChongXiao").Enabled = False             'Cuidong 2000/08/14
'               .Buttons("Delete").Enabled = True                 'Cuidong 2000/08/16
'            End If                                               'Cuidong 2000/08/14
'         End If                                                  'Cuidong 2000/08/14
'         If Trim(UfGridADO1.TextMatrix(UfGridADO1.Row, 8)) <> "" Then .Buttons("Delete").Enabled = False 'Cuidong 2000/08/14
'      End If                                                  'Cuidong 2000.12.25
''      If CheckBook Then                        'Cuidong 2000/08/16
'''         .Buttons("ChongXiao").Enabled = True 'Cuidong 2000/08/16
''         .Buttons("Delete").Enabled = False    'Cuidong 2000/08/16
''      Else                                     'Cuidong 2000/08/16
''         .Buttons("ChongXiao").Enabled = False 'Cuidong 2000/08/16
''         .Buttons("Delete").Enabled = True     'Cuidong 2000/08/16
''      End If                                   'Cuidong 2000/08/16
''      If UfGridADO1.TextMatrix(UfGridADO1.Row, 8) <> "" Then .Buttons("Delete").Enabled = False      'Cuidong 2000/08/14
''      If Trim(UfGridADO1.TextMatrix(UfGridADO1.Row, 8)) <> "" Then .Buttons("Delete").Enabled = False 'Cuidong 2000/08/14
'   End With
'
'End Sub

Private Sub InitPzControl()

   Set aClsPz = New clsPZ
   Set aClsPz.zzLogin = zjLogInfo
   Set aClsPz.zzSys = aClsPub
End Sub