企业管理

开发平台：
Visual Basic

：源码内容
							VERSION 5.00
Object = "{BEEECC20-4D5F-4F8B-BFDC-5D9B6FBDE09D}#1.0#0"; "vsflex8.ocx"
Begin VB.Form Cg_Account 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "月末结帐"
   ClientHeight    =   4725
   ClientLeft      =   45
   ClientTop       =   345
   ClientWidth     =   5100
   HelpContextID   =   1110001
   Icon            =   "月末结账.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4725
   ScaleWidth      =   5100
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton Cmd_Help 
      Caption         =   "帮助(&H)"
      Height          =   300
      Left            =   2565
      TabIndex        =   4
      Top             =   4305
      Width           =   1155
   End
   Begin VB.CommandButton Cmd_Exit 
      Caption         =   "退出(&X)"
      Height          =   300
      Left            =   3795
      TabIndex        =   2
      Top             =   4305
      Width           =   1155
   End
   Begin VB.CommandButton Cmd_CancelAccount 
      Caption         =   "恢复结帐(&N)"
      Height          =   300
      Left            =   1305
      TabIndex        =   1
      Top             =   4305
      Width           =   1155
   End
   Begin VB.CommandButton Cmd_OKAccount 
      Caption         =   "结帐(&Y)"
      Height          =   300
      Left            =   75
      TabIndex        =   0
      Top             =   4305
      Width           =   1155
   End
   Begin VSFlex8Ctl.VSFlexGrid vsFlx_Grid 
      Height          =   4095
      Left            =   90
      TabIndex        =   3
      Top             =   90
      Width           =   4905
      _cx             =   5080
      _cy             =   5080
      Appearance      =   1
      BorderStyle     =   1
      Enabled         =   -1  'True
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      MousePointer    =   0
      BackColor       =   -2147483643
      ForeColor       =   -2147483640
      BackColorFixed  =   -2147483633
      ForeColorFixed  =   -2147483630
      BackColorSel    =   -2147483635
      ForeColorSel    =   -2147483634
      BackColorBkg    =   -2147483636
      BackColorAlternate=   -2147483643
      GridColor       =   -2147483633
      GridColorFixed  =   -2147483632
      TreeColor       =   -2147483632
      FloodColor      =   192
      SheetBorder     =   -2147483642
      FocusRect       =   1
      HighLight       =   1
      AllowSelection  =   -1  'True
      AllowBigSelection=   -1  'True
      AllowUserResizing=   0
      SelectionMode   =   0
      GridLines       =   1
      GridLinesFixed  =   2
      GridLineWidth   =   1
      Rows            =   50
      Cols            =   10
      FixedRows       =   1
      FixedCols       =   1
      RowHeightMin    =   0
      RowHeightMax    =   0
      ColWidthMin     =   0
      ColWidthMax     =   0
      ExtendLastCol   =   0   'False
      FormatString    =   ""
      ScrollTrack     =   -1  'True
      ScrollBars      =   3
      ScrollTips      =   0   'False
      MergeCells      =   0
      MergeCompare    =   0
      AutoResize      =   -1  'True
      AutoSizeMode    =   0
      AutoSearch      =   0
      AutoSearchDelay =   2
      MultiTotals     =   -1  'True
      SubtotalPosition=   1
      OutlineBar      =   0
      OutlineCol      =   0
      Ellipsis        =   0
      ExplorerBar     =   0
      PicturesOver    =   0   'False
      FillStyle       =   0
      RightToLeft     =   0   'False
      PictureType     =   0
      TabBehavior     =   0
      OwnerDraw       =   0
      Editable        =   0
      ShowComboButton =   1
      WordWrap        =   0   'False
      TextStyle       =   0
      TextStyleFixed  =   0
      OleDragMode     =   0
      OleDropMode     =   0
      DataMode        =   0
      VirtualData     =   -1  'True
      DataMember      =   ""
      ComboSearch     =   3
      AutoSizeMouse   =   -1  'True
      FrozenRows      =   0
      FrozenCols      =   0
      AllowUserFreezing=   0
      BackColorFrozen =   0
      ForeColorFrozen =   0
      WallPaperAlignment=   9
      AccessibleName  =   ""
      AccessibleDescription=   ""
      AccessibleValue =   ""
      AccessibleRole  =   24
   End
End
Attribute VB_Name = "Cg_Account"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'***********************************************************************************************************
'*    模 块 名 称 :采购月末处理
'*    功 能 描 述 :此功能模块主要完成采购月末结帐处理
'*    程序员姓名  :李海祥
'*    最后修改人  :李海祥
'*    最后修改时间:2001/12/06
'*    备        注:程序中所有依实际情况自定义部分均用[>>  <<]括起
'*
'***********************************************************************************************************
'以下为固定使用变量
Dim Tsxx As String                       '系统信息提示
Dim Dyymctbl As New DY_Dyymsz            '打印页面窗体变量
Dim GridCode As String                   '显示网格网格代码
Dim GridInf() As Variant                 '整个网格设置信息
Dim Qslz As Long                         '网格隐藏(非操作显示)列数
Dim Sjhgd As Double                      '网格数据行高度
Dim Sfxshjwg As Boolean                  '是否显示合计网格
Dim GridBoolean() As Boolean             '网格列信息(布尔型)
Dim GridStr()  As String                 '网格列信息(字符型)
Dim GridInt() As Integer                 '网格列信息(整型)
Dim Szzls As Integer                     '数组总列数(网格列数-1)
Private Sub Cmd_CancelAccount_Click()
    Dim Lng_Tmp As Long                         '临时使用计数器
    Dim str_Period As String                    '查询会计期间字符串
    Dim rs_Period As New ADODB.Recordset        '判断会计期间记录集
    With Me.vsFlx_Grid
        For Lng_Tmp = .Rows - 1 To .FixedRows Step -1
            If Trim(.TextMatrix(Lng_Tmp, Sydz("004", GridStr(), Szzls))) = "√" Then
                .Row = Lng_Tmp
                Exit For
            End If
        Next Lng_Tmp
        If Lng_Tmp < .FixedRows Then
            Call Xtxxts("没有要恢复结帐的会计期间!", 0, 4)
            Exit Sub
        End If
        
        str_Period = "select * from Gy_kjrlb where BeginFlag='1'"
        Set rs_Period = Cw_DataEnvi.DataConnect.Execute(str_Period)
        If Not rs_Period.EOF Then
            If rs_Period.Fields("KjYear") = S2N(Left(Trim(.TextMatrix(.Row, Sydz("001", GridStr(), Szzls))), 4)) And rs_Period.Fields("Period") > S2N(Right(Trim(.TextMatrix(.Row, Sydz("001", GridStr(), Szzls))), 2)) Then
                Call Xtxxts("系统期初月份为" & rs_Period.Fields("Period") & "不能恢复结帐!", 0, 4)
                Exit Sub
            End If
        End If
        Set rs_Period = Nothing
        str_Period = "select top 1 *  from Gy_kjrlb where cgjzbz=1 order by KjYear desc,Period desc "
        Set rs_Period = Cw_DataEnvi.DataConnect.Execute(str_Period)
        If Not rs_Period.EOF Then
            If rs_Period.Fields("Kjyear") > S2N(Left(Trim(.TextMatrix(.Row, Sydz("001", GridStr(), Szzls))), 4)) Or (rs_Period.Fields("Kjyear") = S2N(Left(Trim(.TextMatrix(.Row, Sydz("001", GridStr(), Szzls))), 4)) And rs_Period.Fields("Period") > S2N(Right(Trim(.TextMatrix(.Row, Sydz("001", GridStr(), Szzls))), 2))) Then
                Call Xtxxts("要恢复的会计期间的下一会计期间已经结帐，不能恢复结帐!", 0, 4)
                Exit Sub
            End If
        End If
        Set rs_Period = Nothing
        str_Period = "select top 1 *  from Gy_kjrlb where cgjzbz=1 order by KjYear desc,Period desc "
        
        Set rs_Period = Cw_DataEnvi.DataConnect.Execute(str_Period)
        Cw_DataEnvi.DataConnect.BeginTrans
    On erron GoTo Err_Ctrl
        Cw_DataEnvi.DataConnect.Execute ("CG_SP_CancelAccount " & rs_Period.Fields("KjYear") & "," & rs_Period.Fields("Period"))
        Cw_DataEnvi.DataConnect.CommitTrans
        '恢复当月结帐标识为未结帐
        .TextMatrix(Lng_Tmp, Sydz("004", GridStr(), Szzls)) = ""
        .Row = Lng_Tmp - 1
        Call Xtxxts("恢复结帐完成!", 0, 4)
    End With
    Exit Sub
Err_Ctrl:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Call Xtxxts("恢复结帐失败，返回结帐状态!", 0, 4)
End Sub
Private Sub Cmd_Exit_Click()
    Unload Me
End Sub
Private Sub Cmd_Help_Click()
    Call F1bz
End Sub
Private Sub Cmd_OKAccount_Click()
    Dim int_MsgResult As Integer            '提示返回函数
    Dim Lng_Jsq As Long                     '临时使用计数器
    Dim str_Invoice As String               '查询发票和收料通知单字符串
    Dim rs_Invoice As New ADODB.Recordset   '判断是否有未审核发票和未审核收料通知单记录集
    Dim str_Period As String                '查询会计期间字符串
    Dim rs_Period As New ADODB.Recordset    '判断会计期间记录集
    '判断选择合法性
    With Me.vsFlx_Grid
        For Lng_Jsq = .FixedRows To .Rows - 1
            If Trim(.TextMatrix(Lng_Jsq, Sydz("004", GridStr(), Szzls))) <> "√" Then Exit For
        Next Lng_Jsq
        If Lng_Jsq >= .Rows Then Exit Sub
        int_MsgResult = Xtxxts("你确定要结帐吗？", 1, 4)
        
        If int_MsgResult = 6 Then
            '判断是否允许结帐
            str_Invoice = "select * from CG_InvoiceMain where KjYear=" & S2N(Left(Trim(.TextMatrix(Lng_Jsq, Sydz("001", GridStr(), Szzls))), 4)) & " and Period=" & S2N(Right(Trim(.TextMatrix(Lng_Jsq, Sydz("001", GridStr(), Szzls))), 2)) & " and  Checker='' and PeriodStarFlag=0"
            Set rs_Invoice = Cw_DataEnvi.DataConnect.Execute(str_Invoice)
            If Not rs_Invoice.EOF() Then
                Call Xtxxts("结帐会计期间有未审核的发票,不能结帐!", 0, 4)
                Exit Sub
            End If
            Set rs_Invoice = Nothing
            str_Invoice = "select * from CG_PurReciptMain where KjYear=" & S2N(Left(Trim(.TextMatrix(Lng_Jsq, Sydz("001", GridStr(), Szzls))), 4)) & " and Period=" & S2N(Right(Trim(.TextMatrix(Lng_Jsq, Sydz("001", GridStr(), Szzls))), 2)) & " and  Checker=''"
            Set rs_Invoice = Cw_DataEnvi.DataConnect.Execute(str_Invoice)
            If Not rs_Invoice.EOF() Then
                Call Xtxxts("结帐会计期间有未审核的收料或退货通知单,不能结帐!", 0, 4)
                Exit Sub
            End If
            str_Period = "select top 1 *  from Gy_kjrlb where cgjzbz=0 order by KjYear ,Period  "
            Set rs_Period = Cw_DataEnvi.DataConnect.Execute(str_Period)
            If Not rs_Period.EOF Then
                If rs_Period.Fields("Kjyear") < S2N(Left(Trim(.TextMatrix(.Row, Sydz("001", GridStr(), Szzls))), 4)) Or (rs_Period.Fields("Kjyear") = S2N(Left(Trim(.TextMatrix(.Row, Sydz("001", GridStr(), Szzls))), 4)) And rs_Period.Fields("Period") < S2N(Right(Trim(.TextMatrix(.Row, Sydz("001", GridStr(), Szzls))), 2))) Then
                    Call Xtxxts("要结帐的会计期间的上一会计期间没有结帐，不能进行结帐!", 0, 4)
                    Exit Sub
                End If
            End If
            Set rs_Period = Nothing
            
            Cw_DataEnvi.DataConnect.BeginTrans
            On erron GoTo Err_Ctrl
            Cw_DataEnvi.DataConnect.Execute ("CG_SP_Account " & S2N(Left(Trim(.TextMatrix(Lng_Jsq, Sydz("001", GridStr(), Szzls))), 4)) & "," & S2N(Right(Trim(.TextMatrix(Lng_Jsq, Sydz("001", GridStr(), Szzls))), 2)) & ",'" & Xtczy & "'")
            
            Cw_DataEnvi.DataConnect.CommitTrans
            '填充当月结帐标识
            .TextMatrix(Lng_Jsq, Sydz("004", GridStr(), Szzls)) = "√"
            If .Row < .Rows - 1 Then
                If Lng_Jsq < .Row - 1 Then
                    .Row = Lng_Jsq + 1
                Else
                    .Row = Lng_Jsq
                End If
            End If
            Call Xtxxts("月末结帐完成!", 0, 4)
        End If
    End With
    Exit Sub
Err_Ctrl:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Call Xtxxts("月末结帐失败，返回未结帐状态!", 0, 4)
End Sub
Private Sub Form_Load()
    Dim rs_Record As New ADODB.Recordset        '填充网格记录集
    Dim Str_Temp As String                      '临时使用字符串
    
    '调入网格
    GridCode = "Cg_Account"
    Call BzWgcsh(Me.vsFlx_Grid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
    Qslz = GridInf(1)
    Sjhgd = GridInf(2)
    Sfxshjwg = GridInf(7)
    Szzls = Me.vsFlx_Grid.Cols - 1
    
    '设置列居中显示
    vsFlx_Grid.ColAlignment(Sydz("001", GridStr(), Szzls)) = flexAlignCenterCenter
    vsFlx_Grid.ColAlignment(Sydz("004", GridStr(), Szzls)) = flexAlignCenterCenter
    '查询填充网格
    Str_Temp = "select * from Gy_kjrlb where kjyear='" + Trim(Str(Xtyear)) + "' order by KjYear,Period,qsrq,zzrq,cgjzbz"
    Set rs_Record = Cw_DataEnvi.DataConnect.Execute(Str_Temp)
    With Me.vsFlx_Grid
        .Rows = .FixedRows
        Do While Not rs_Record.EOF()
            .AddItem ""
            .RowHeight(.Rows - 1) = Sjhgd
            .TextMatrix(.Rows - 1, Sydz("001", GridStr(), Szzls)) = Trim(Str(rs_Record.Fields("kjyear"))) + "." + Mid(Trim(Str(100 + rs_Record.Fields("period"))), 2, 2)        '会计期间
            .TextMatrix(.Rows - 1, Sydz("002", GridStr(), Szzls)) = Format(Trim(rs_Record.Fields("qsrq") & ""), "yyyy-mm-dd")                                                   '起始日期
            .TextMatrix(.Rows - 1, Sydz("003", GridStr(), Szzls)) = Format(Trim(rs_Record.Fields("zzrq") & ""), "yyyy-mm-dd")                                                   '结束日期
            If rs_Record.Fields("cgjzbz") Then
                .TextMatrix(.Rows - 1, Sydz("004", GridStr(), Szzls)) = "√"                                                                                                    '是否结帐
            End If
            rs_Record.MoveNext
        Loop
        For i = .FixedRows To .Rows - 1
            If Trim(.TextMatrix(i, Sydz("004", GridStr(), Szzls))) = "√" Then
                .Row = i
                Exit For
            Else
                .Row = 1
            End If
        Next i
    End With
End Sub
  

						