+

财务分析 财财务分析务分析

               '1.放置字段有效性判断程序
               Case "001"          '科目(如有效则调入科目编码)
                 If Len(Str_JudgeText) <> 0 Then
                      SqlStr = "Select a.*,b.Cname FROM Cwfx_BaseProjSet a,Cwzz_Acccode b Where a.Ccode=b.Ccode and (a.Ccode='" & Str_JudgeText & "' OR b.CName='" & Str_JudgeText & "')"
                      Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                      With RecTemp
                           If .EOF Then
                              Tsxx = "此项目不存在!"
                              GoTo Lrcwcl
                           End If
                                                           
                           '1.如果科目存在则存储相应预算科目编码
                           WglrGrid.TextMatrix(Dqpdwgh, 2) = Trim(RecTemp.Fields("Ccode"))
                           WglrGrid.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = Trim(RecTemp.Fields("CName"))
                      End With
                   Else
                      WglrGrid.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls)) = ""
                  End If
       
                              
               '2.放置字段事后处理程序
                                        '科目所要进行核算项不能为空
                If (Not .ColHidden(Sydz("001", GridStr(), Szzls))) And Trim(.TextMatrix(Dqpdwgh, Sydz("001", GridStr(), Szzls))) = "" Then
                   Tsxx = "此项目不能为空!"
                   Lrywlz = Sydz("001", GridStr(), Szzls)
                   GoTo Lrcwcl
                End If

             
         '以上为自定义部分]
            
     End Select
     
     '字段录入正确后为零字段清空
      Call Qkwlzd(Dqpdwgh, Dqpdwgl)
    
     sjzdyxxpd = True
     Yxxpdlock = True
     Exit Function
 End With
  
Lrcwcl:    '录入错误处理
  With WglrGrid
      Call Xtxxts(Tsxx, 0, 1)
      changelock = True
      .Select Dqpdwgh, Dqpdwgl
      changelock = False
      Call xswbk
      sjzdyxxpd = False
      Exit Function
   End With
End Function
Private Function Sjhzyxxpd(Yxxpdh As Long) As Boolean                  '录入数据行有效性判断,同时进行行处理
 Dim Lrywlz As Long
 Dim RecTemp As New ADODB.Recordset             '临时使用动态集
 Dim SqlStr As String                           '临时连接字符串
 Dim Rec_AccSumAssi As New ADODB.Recordset      '辅助总帐动态集
 Dim Dbl_Now(1 To 16) As Double                 '科目记录现数据
 Dim Str_OriItemCode As String                  '辅助核算项目编码(原)
 Dim Str_NowItemCode As String                  '辅助核算项目编码(现)
 Dim Int_Direction As Integer                   '记录收支方向
    
 With WglrGrid

    '判断行为空和无效数据行则清除当前行
    If .TextMatrix(Yxxpdh, 0) <> "*" Then
       Sjhzyxxpd = True
       Exit Function
     Else
       If pdhwk(Yxxpdh) And Yxxpdh + 1 <= .Rows - 1 Then
           If .TextMatrix(Yxxpdh + 1, 0) <> "*" Then
              changelock = True
              .RemoveItem Yxxpdh
              If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
                 .AddItem ""
                 .RowHeight(.Rows - 1) = Sjhgd
              End If
              changelock = False
              Sjhzyxxpd = True
              Exit Function
           End If
        End If
    End If
    
    '行没有发生变化则不进行有效性判断
    If Hyxxpdlock Then
       Sjhzyxxpd = True
       Exit Function
    End If
  
   '以下为自定义部分[

        '1.放置行有效性判断程序

           '首先进行为空判断(固定不变)
           For Jsqte = Qslz To .Cols - 1
               If (GridInt(Jsqte, 5) = 1 And Len(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0) Or (GridInt(Jsqte, 5) = 2 And Val(Trim(.TextMatrix(Yxxpdh, Jsqte))) = 0) Then
                  Tsxx = GridStr(Jsqte, 2)
                  Lrywlz = Jsqte
                  GoTo Lrcwcl
                  Exit For
               End If
           Next Jsqte
           
         '科目所要进行核算项不能为空
           If (Not .ColHidden(Sydz("001", GridStr(), Szzls))) And Trim(.TextMatrix(Yxxpdh, Sydz("001", GridStr(), Szzls))) = "" Then
              Tsxx = "预算项目不能为空!"
              Lrywlz = Sydz("001", GridStr(), Szzls)
              GoTo Lrcwcl
           End If
           If (Not .ColHidden(Sydz("002", GridStr(), Szzls))) And Trim(.TextMatrix(Yxxpdh, Sydz("002", GridStr(), Szzls))) = "" Then
              Tsxx = "收支方向不能为空!"
              Lrywlz = Sydz("002", GridStr(), Szzls)
              GoTo Lrcwcl
           End If
           
          Int_Direction = IIf(WglrGrid.TextMatrix(Yxxpdh, Sydz("002", GridStr(), Szzls)) = "收入", 0, 1)
         '判断记录是否重复
          SqlStr = "SELECT cwfx_CashIncomeCostSet.I_id From cwfx_CashIncomeCostSet WHERE Ccode='" & WglrGrid.TextMatrix(Yxxpdh, 2) & "' And Year=" & Str(Int_OriYear)
          SqlStr = SqlStr + " and Direction=" + Trim(Str(Int_Direction))

           Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
           If Not RecTemp.EOF Then
              If RecTemp.Fields("I_ID") <> Val(WglrGrid.TextMatrix(Yxxpdh, 1)) Then
                 Tsxx = "录入记录重复!"
                 For Jsqte = Qslz To WglrGrid.Cols - 1
                     If Not WglrGrid.ColHidden(Jsqte) Then
                        Lrywlz = Jsqte
                     End If
                 Next Jsqte
                 GoTo Lrcwcl
              End If
           End If

        '2.进行行数据回写
    
 End With
 
        On Error GoTo Swcwcl

        Cw_DataEnvi.DataConnect.BeginTrans

        With Rec_AccSumAssi

          If Val(Trim(WglrGrid.TextMatrix(Yxxpdh, 1))) <> 0 Then
             If .State = 1 Then .Close
             .Open "SELECT cwfx_CashIncomeCostSet.* From cwfx_CashIncomeCostSet WHERE I_id = " & Val(WglrGrid.TextMatrix(Yxxpdh, 1)), Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic

             If Not .EOF Then
                .Fields("Ccode") = WglrGrid.TextMatrix(Yxxpdh, 2)                                            '预算科目
                .Fields("Year") = Int_OriYear                                           '会计年度
                .Fields("Direction") = IIf(WglrGrid.TextMatrix(Yxxpdh, Sydz("002", GridStr(), Szzls)) = "收入", 0, 1)
                .Fields("Budget") = Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("003", GridStr(), Szzls)))
                 
                 .Update

                 '更新其他各会计期间数据
                  
            End If
            
         Else
            If .State = 1 Then .Close
             .Open "SELECT cwfx_CashIncomeCostSet.* From cwfx_CashIncomeCostSet WHERE I_id = " & Val(WglrGrid.TextMatrix(Yxxpdh, 1)), Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic

            .AddNew
                .Fields("Ccode") = WglrGrid.TextMatrix(Yxxpdh, 2)                                            '预算科目
                .Fields("Year") = Int_OriYear                                           '会计年度
                .Fields("Direction") = IIf(WglrGrid.TextMatrix(Yxxpdh, Sydz("002", GridStr(), Szzls)) = "收入", 0, 1)
                .Fields("Budget") = Val(WglrGrid.TextMatrix(Yxxpdh, Sydz("003", GridStr(), Szzls)))
                
            .Update
                 
                 WglrGrid.TextMatrix(Yxxpdh, 1) = .Fields("I_id")
                 

         End If
         
    End With
        
        Cw_DataEnvi.DataConnect.CommitTrans
        
        ' <<]

   '以上为自定义部分]

 Sjhzyxxpd = True
 Hyxxpdlock = True
 Exit Function
 
Swcwcl:
     Cw_DataEnvi.DataConnect.RollbackTrans
     Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
     Call Xtxxts(Tsxx, 0, 1)
     Exit Function

Lrcwcl:      '录入错误处理
  With WglrGrid
      Call Xtxxts(Tsxx, 0, 1)
      changelock = True
      .Select Yxxpdh, Lrywlz
      changelock = False
      Call xswbk

      Sjhzyxxpd = False
      Exit Function
  End With
End Function

'===================以 下 程 序 为 通 用 部 分 ,一 般 不 需 更 改======================='
Private Sub Sub_AdjustGrid()
  '调 整 网 格
  With WglrGrid
    '加 1 保持一行录入行
     If .Rows < Pmbcsjhs + .FixedRows + Fzxwghs + 1 Then
        .Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
           For Jsqte = .FixedRows To .Rows - 1
             .RowHeight(Jsqte) = Sjhgd
           Next Jsqte
     Else
        '判断是否有辅助行和录入行,如没有则加行
        Do While .TextMatrix(.Rows - 1 - Fzxwghs, 0) = "*"
          .AddItem ""
          .RowHeight(.Rows - 1) = Sjhgd
        Loop
     End If
  End With
End Sub
Private Sub Lrzdbz()                                                      '录入字段帮助
   If Not Ydcommand.Visible Then
      Exit Sub
   End If
  Valilock = True
  With WglrGrid
       
    changelock = True        '调入另外窗体必须加锁
      If .Col = Sydz("001", GridStr(), Szzls) Then
         Call Drbmhelp(GridInt(.Col, 6), GridStr(.Col, 3), Trim(Ydtext.Text))
      End If
    changelock = False
    If Len(Xtfhcs) <> 0 Then
       If GridInt(.Col, 7) = 0 Then
          Ydtext.Text = Xtfhcs
       Else
          Ydtext.Text = Xtfhcsfz
       End If
    End If
        
  Valilock = False
  If Ydtext.Visible Then
    Ydtext.SetFocus
  End If
 End With
End Sub
Private Sub Form_Resize()                                                '窗体大小发生变化时,重新显示文本框
   Call Cxxswbk
End Sub
Private Function Fun_Drfrmyxxpd() As Boolean                             '调入其它窗体或功能产生的有效性判断(包括数据回写)
  Fun_Drfrmyxxpd = True
  With WglrGrid
   
   '如果当前网格处于编辑状态,则先进行数据回写再进行有效性判断
  
   If Ydtext.Visible Or YdCombo.Visible Then
        Call Lrsjhx
        If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
           Fun_Drfrmyxxpd = False
           Exit Function
        End If
   End If
   
   '进行行有效性判断
   If Not Sjhzyxxpd(.Row) Then
      Fun_Drfrmyxxpd = False
      Exit Function
   End If
   
  End With
End Function
Private Sub WglrGrid_GotFocus()                                     '网格得到焦点

  '网格得到焦点,如果当前选择行为非数据行
  '则调整当前焦点至有效数据行

    With WglrGrid
      If .Row < .FixedRows And .Rows > .FixedRows Then
         changelock = True
          .Select .FixedRows, .Col
         changelock = False
      End If
      If .Col < Qslz Then
         changelock = True
          .Select .Row, Qslz
         changelock = False
      End If
    End With

End Sub
Private Sub WglrGrid_LostFocus()                                    '录入网格失去焦点

  '用以屏蔽调用其它窗体时发生网格失去焦点事件
  If changelock Then
     Exit Sub
  End If

  '引发网格RowcolChange事件
  With WglrGrid
    If Not (Ydtext.Visible Or YdCombo.Visible) Then
       .Select 0, 0
    End If
  End With

End Sub
Private Sub WglrGrid_Scroll()                                       '限制用户在录入过程中滚动鼠标

 If Gdtlock Then
    Exit Sub
 End If
 
 With WglrGrid
  If Ydtext.Visible Or YdCombo.Visible Then
     Gdtlock = True
     .TopRow = Dqtoprow
     .LeftCol = Dqleftcol
     Gdtlock = False
     Exit Sub
  End If
  
 End With
End Sub
Private Sub WglrGrid_LeaveCell()                                    '离开单元格
  If changelock Then
     Exit Sub
  End If

  '记录刚刚离开网格单元的行列值
  Dqlkwgh = WglrGrid.Row
  Dqlkwgl = WglrGrid.Col

  '判断是否需要录入数据回写
  If Not (Ydtext.Visible Or YdCombo.Visible) Then
     Exit Sub
  End If
  Call Lrsjhx
End Sub
Private Sub WglrGrid_RowColChange()                                '网格录入行列发生变化时,进行有效性判断
   Valilock = True       '屏蔽文本框失去焦点进行有效性判断
   With WglrGrid
     If changelock Then
        Exit Sub
     End If
     If Not sjzdyxxpd(Dqlrwgh, Dqlrwgl) Then
        Exit Sub
     End If
     If .Row <> Dqlkwgh Then
        If Not Sjhzyxxpd(Dqlkwgh) Then
           Exit Sub
        End If
     End If
   End With
   Call fhyxh
   Call Xldql
   
End Sub
Private Sub WglrGrid_DblClick()          '鼠标双击网格显示文本框
  Dim i As Integer
  Dim Bln_Add As Boolean