企业管理

开发平台：
Visual Basic

：源码内容
							VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Begin VB.Form KF_FrmCheck 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "月末结帐"
   ClientHeight    =   3510
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4530
   ForeColor       =   &H80000008&
   HelpContextID   =   1216001
   Icon            =   "月末处理_月末结帐.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3510
   ScaleWidth      =   4530
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin TabDlg.SSTab SSTab1 
      Height          =   2955
      Left            =   45
      TabIndex        =   0
      Top             =   0
      Width           =   4410
      _ExtentX        =   7779
      _ExtentY        =   5212
      _Version        =   393216
      Style           =   1
      Tabs            =   2
      TabHeight       =   520
      TabCaption(0)   =   "月末结帐"
      TabPicture(0)   =   "月末处理_月末结帐.frx":1042
      Tab(0).ControlEnabled=   -1  'True
      Tab(0).Control(0)=   "Frame1(0)"
      Tab(0).Control(0).Enabled=   0   'False
      Tab(0).ControlCount=   1
      TabCaption(1)   =   "恢复月末结帐"
      TabPicture(1)   =   "月末处理_月末结帐.frx":105E
      Tab(1).ControlEnabled=   0   'False
      Tab(1).Control(0)=   "Frame1(1)"
      Tab(1).Control(0).Enabled=   0   'False
      Tab(1).ControlCount=   1
      Begin VB.Frame Frame1 
         Height          =   2520
         Index           =   1
         Left            =   -74910
         TabIndex        =   7
         Top             =   330
         Width           =   4215
         Begin VB.Frame Frame2 
            Caption         =   "会计期间"
            Height          =   615
            Index           =   1
            Left            =   2955
            TabIndex        =   15
            Top             =   240
            Width           =   1125
            Begin VB.Label lblUnYear 
               ForeColor       =   &H00FF0000&
               Height          =   210
               Left            =   120
               TabIndex        =   16
               Top             =   300
               Width           =   930
            End
         End
         Begin VB.CommandButton QdQuitU 
            Caption         =   "退出"
            Height          =   330
            Left            =   2955
            TabIndex        =   11
            Top             =   2055
            Width           =   1125
         End
         Begin VB.CommandButton QdOkU 
            Caption         =   "恢复结帐"
            Height          =   330
            Left            =   2955
            TabIndex        =   10
            Top             =   1590
            Width           =   1125
         End
         Begin VB.CommandButton QdAllU 
            Caption         =   "全选"
            Height          =   330
            Left            =   2955
            TabIndex        =   9
            Tag             =   "全消"
            Top             =   1125
            Width           =   1125
         End
         Begin VB.ListBox Lst_Uncheck 
            Height          =   2160
            Left            =   135
            Style           =   1  'Checkbox
            TabIndex        =   8
            Top             =   240
            Width           =   2700
         End
      End
      Begin VB.Frame Frame1 
         Height          =   2520
         Index           =   0
         Left            =   90
         TabIndex        =   1
         Top             =   330
         Width           =   4215
         Begin VB.Frame Frame2 
            Caption         =   "会计期间"
            Height          =   615
            Index           =   0
            Left            =   2955
            TabIndex        =   13
            Top             =   240
            Width           =   1125
            Begin VB.Label lblCheckYear 
               ForeColor       =   &H00FF0000&
               Height          =   210
               Left            =   120
               TabIndex        =   14
               Top             =   300
               Width           =   900
            End
         End
         Begin VB.ListBox Lst_Check 
            Height          =   2160
            Left            =   135
            Style           =   1  'Checkbox
            TabIndex        =   5
            Top             =   240
            Width           =   2700
         End
         Begin VB.CommandButton QdAll 
            Caption         =   "全选"
            Height          =   330
            Left            =   2955
            TabIndex        =   4
            Tag             =   "全消"
            Top             =   1125
            Width           =   1120
         End
         Begin VB.CommandButton QdOk 
            Caption         =   "结帐"
            Height          =   330
            Left            =   2955
            TabIndex        =   3
            Top             =   1590
            Width           =   1120
         End
         Begin VB.CommandButton QdQuit 
            Caption         =   "退出"
            Height          =   330
            Left            =   2955
            TabIndex        =   2
            Top             =   2055
            Width           =   1120
         End
      End
   End
   Begin MSComctlLib.ProgressBar PB 
      Height          =   225
      Left            =   75
      TabIndex        =   6
      Top             =   3225
      Width           =   4380
      _ExtentX        =   7726
      _ExtentY        =   397
      _Version        =   393216
      Appearance      =   1
      MousePointer    =   4
      Scrolling       =   1
   End
   Begin VB.Label Lb 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Height          =   180
      Left            =   1545
      TabIndex        =   12
      Top             =   3030
      Width           =   90
   End
End
Attribute VB_Name = "KF_FrmCheck"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'*****************************************************************
'*   模块名称：月末结帐
'*   模块功能：设置库存管理系统月末结帐
'*   编 制 者：赵宇光
'*   编制日期：2001/12/11
'*   备    注：
'*****************************************************************
Dim adoWare As New ADODB.Recordset
Dim Tsxx As String
Dim strWhCode() As String
Dim strWh As String
Dim ChkYear As Integer                  '结账或恢复结帐年度
Dim ChkMonth As Integer                 '结账或恢复结帐月份
Dim bls As Boolean
Const YMConnect = "."                   '年度和月份联字符
Public Function FillKjYear(ChkFlag As Boolean, intYear As Integer, intMonth As Integer)
'函数功能：根据用户选择，取得月末结帐或恢复月末结帐的月份
'输入参数：ChkFlag(结账或恢复结帐选择----True:结账   False:恢复结帐)
'输出参数：intYear(结账或恢复结帐年度)    intMonth(结账或恢复结帐月份)
    
    Dim adoRec As New ADODB.Recordset
    Dim strSQL As String
    Dim adoTemp As New ADODB.Recordset
    Dim WhFlag As Boolean
    Dim strTemp As String
    
    strTemp = "SELECT EndDealFlagWh FROM Gy_WareHouse WHERE EndDealFlagWh=1"
    Set adoTemp = Cw_DataEnvi.DataConnect.Execute(strTemp)
    
    If Not adoTemp.EOF Then
        WhFlag = True
    End If
    adoTemp.Close
    Set adoTemp = Nothing
    
    If ChkFlag = True Then
        strSQL = "SELECT KjYear,Period FROM GY_KJRLB WHERE KFjzbz=0 ORDER BY kjyear,Period"
    Else
        If WhFlag = True Then
            strSQL = "SELECT KjYear,Period FROM GY_KJRLB WHERE KFjzbz=0 ORDER BY kjyear,Period"
        Else
            strSQL = "SELECT KjYear,Period FROM GY_KJRLB WHERE KFjzbz=1 ORDER BY kjyear,Period DESC"
        End If
    End If
    
    Set adoRec = Cw_DataEnvi.DataConnect.Execute(strSQL)
    
    With adoRec
        If Not .EOF Then
            .MoveFirst
            intYear = .Fields("KjYear")
            intMonth = .Fields("Period")
        End If
    End With
    adoRec.Close
    Set adoRec = Nothing
End Function
Private Sub FillWare(L As ListBox, Czybm As String, ChkFlag As Boolean)
    '填充仓库(001-listbox,002-操作员编码,003-结帐与恢复结帐标志)
    
    Dim strQuery As String
    Dim strTemp As String
    Dim i As Integer
    Dim adoWare As New ADODB.Recordset
    Dim adoTemp As New ADODB.Recordset
    Dim JZFlag As Boolean
    
    strTemp = "SELECT KFjzbz FROM GY_KJRLB WHERE KjYear=" & ChkYear & " and Period=" & ChkMonth
    Set adoTemp = Cw_DataEnvi.DataConnect.Execute(strTemp)
    
    If Not adoTemp.EOF Then
        JZFlag = CBool(adoTemp.Fields("kfjzbz"))
    End If
    adoTemp.Close
    Set adoTemp = Nothing
    
    If ChkFlag = True Then
        If JZFlag = True Then
            strQuery = "SELECT  whcode,whname FROM kf_v_whlimit WHERE 1=2"
        Else
            strQuery = "SELECT  whcode,whname FROM kf_v_whlimit WHERE czybm='" & Trim(Czybm) & "' AND EndDealFlagWh=0"
        End If
    Else
        If JZFlag = True Then
            strQuery = "SELECT  whcode,whname FROM kf_v_whlimit WHERE czybm='" & Trim(Czybm) & "' AND EndDealFlagWh=0"
        Else
            strQuery = "SELECT  whcode,whname FROM kf_v_whlimit WHERE czybm='" & Trim(Czybm) & "' AND EndDealFlagWh=1"
        End If
    End If
    
    Set adoWare = Cw_DataEnvi.DataConnect.Execute(strQuery)
    
    With adoWare
        If Not .EOF Then
            ReDim strWhCode(adoWare.RecordCount)
        End If
    End With
    
    L.Clear
    With L
        For i = 0 To adoWare.RecordCount - 1
             .AddItem Trim(adoWare.Fields("whcode")) + "-" + Trim(adoWare.Fields("whname"))
             strWhCode(i) = Trim(adoWare.Fields("whcode"))
             adoWare.MoveNext
        Next i
    End With
    
    adoWare.Close
    Set adoWare = Nothing
End Sub
Private Sub Form_Load()
    '填充会计期间
    Call FillKjYear(True, ChkYear, ChkMonth)
    lblCheckYear.Caption = CStr(ChkYear) & "." & CStr(ChkMonth)
    '填充结帐仓库
    Call FillWare(Lst_Check, Xtczybm, True)
    PB.Visible = False
    Me.Height = Me.Height - 500
    
End Sub
Private Sub QdAll_Click()
    '结帐全选
    
    If QdAll.Caption = "全选" Then
        QdAll.Tag = "全消"
        For i = 0 To Lst_Check.ListCount - 1
            Lst_Check.Selected(i) = True
        Next i
    Else
        For i = 0 To Lst_Check.ListCount - 1
          Lst_Check.Selected(i) = False
        Next i
    End If
    
    strTemp = QdAll.Caption
    QdAll.Caption = QdAll.Tag
    QdAll.Tag = strTemp
End Sub
Private Sub QdAllU_Click()
    '恢复结帐全选
    If QdAllU.Caption = "全选" Then
        QdAllU.Tag = "全消"
        For i = 0 To Lst_Uncheck.ListCount - 1
            Lst_Uncheck.Selected(i) = True
        Next i
    Else
        For i = 0 To Lst_Uncheck.ListCount - 1
          Lst_Uncheck.Selected(i) = False
        Next i
    End If
       
    strTemp = QdAllU.Caption
    QdAllU.Caption = QdAllU.Tag
    QdAllU.Tag = strTemp
End Sub
Private Sub QdOk_Click()
    '结帐处理
    
    If Not B_Status(Lst_Check) Then
        Tsxx = "您没有选仓库,请先选择!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    End If
    
    On Error GoTo Swcwcl
    Me.Height = Me.Height + 500
    Me.Refresh
    PB.Visible = True
    PB.Max = Lst_Check.ListCount
    PB.Min = 0: PB.Value = 0
    Cw_DataEnvi.DataConnect.BeginTrans
         For i = 0 To Lst_Check.ListCount - 1
            If Lst_Check.Selected(i) Then
                Cw_DataEnvi.DataConnect.Execute ("KF_SP_Check   '" & Trim(Xtczy) & "'," & ChkYear & "," & ChkMonth & ",'" & Trim(strWhCode(i)) & "'")    '实物帐结帐
                Cw_DataEnvi.DataConnect.Execute ("KF_SP_MateCheck   '" & Trim(Xtczy) & "'," & ChkYear & "," & ChkMonth & ",'" & Trim(strWhCode(i)) & "'")   '材料帐结帐
            End If
            PB.Value = i + 1
            Lb.Caption = "已完成" & CStr(Int(PB.Value * 100 / PB.Max)) & "%"
            Lb.Refresh
         Next i
     Cw_DataEnvi.DataConnect.CommitTrans
    Tsxx = "月末结帐成功!"
    Call Xtxxts(Tsxx, 0, 4)
    Call SSTab1_Click(0)
    Lb.Caption = ""
    PB.Visible = False
    Me.Height = Me.Height - 500
    Exit Sub
Swcwcl:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "月末结帐失败,系统恢复到初始状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Me.Height = Me.Height - 500
    Exit Sub
End Sub
Private Sub QdOkU_Click()
    '恢复结帐
    
    Dim adoRec As New ADODB.Recordset
    Dim strSQL As String
        If Not B_Status(Lst_Uncheck) Then
        Tsxx = "您没有选仓库,请先选择!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    End If
    
    On Error GoTo Swcwcl
    '如果核算系统已经完成结账,则不允许恢复结账
    strSQL = "SELECT KfJzbz,ChhsJzbz FROM Gy_Kjrlb WHERE KjYear=" & ChkYear & " AND Period=" & ChkMonth
    Set adoRec = Cw_DataEnvi.DataConnect.Execute(strSQL)
    If adoRec.Fields("chhsjzbz") Then
        Tsxx = "存货核算系统已经完成本月结帐,不允许恢复月末结帐!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    End If
    
    adoRec.Close
    Set adoRec = Nothing
    
    Me.Height = Me.Height + 500
    Me.Refresh
    PB.Visible = True
    PB.Max = Lst_Uncheck.ListCount
    PB.Min = 0: PB.Value = 0
    Cw_DataEnvi.DataConnect.BeginTrans
         For i = 0 To Lst_Uncheck.ListCount - 1
            If Lst_Uncheck.Selected(i) Then
                Cw_DataEnvi.DataConnect.Execute ("KF_SP_UnCheck   '" & Trim(Xtczy) & "'," & ChkYear & "," & ChkMonth & ",'" & Trim(strWhCode(i)) & "'")
                Cw_DataEnvi.DataConnect.Execute ("KF_SP_UnMateCheck   '" & Trim(Xtczy) & "'," & ChkYear & "," & ChkMonth & ",'" & Trim(strWhCode(i)) & "'")
            Else
                Cw_DataEnvi.DataConnect.Execute ("Update Gy_Warehouse SET EndDealFlagWh=1 WHERE WhCode='" & Trim(strWhCode(i)) & "'")
            End If
            PB.Value = i + 1
            Lb.Caption = "已完成" & CStr(Int(PB.Value * 100 / PB.Max)) & "%"
            Lb.Refresh
         Next i
    Cw_DataEnvi.DataConnect.CommitTrans
    Tsxx = "恢复月末结帐成功!"
    Call Xtxxts(Tsxx, 0, 4)
    Call SSTab1_Click(1)
    Lb.Caption = ""
    PB.Visible = False
    Me.Height = Me.Height - 500
    Exit Sub
Swcwcl:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "恢复月末结帐失败,系统恢复到初始状态!"
    Call Xtxxts(Tsxx, 0, 1)
    Me.Height = Me.Height - 500
    Exit Sub
End Sub
Private Sub QdQuit_Click()
    Unload Me
End Sub
Private Sub QdQuitU_Click()
    Unload Me
End Sub
Private Sub SSTab1_Click(PreviousTab As Integer)
    If SSTab1.Tab = 1 Then
        QdAllU.Caption = "全选"
        Call FillKjYear(False, ChkYear, ChkMonth)
        lblUnYear.Caption = CStr(ChkYear) & "." & CStr(ChkMonth)
        '填充结帐仓库
        Call FillWare(Lst_Uncheck, Xtczybm, False)
    Else
        QdAll.Caption = "全选"
        '填充会计期间
        Call FillKjYear(True, ChkYear, ChkMonth)
        lblCheckYear.Caption = CStr(ChkYear) & "." & CStr(ChkMonth)
        '填充结帐仓库
        Call FillWare(Lst_Check, Xtczybm, True)
    End If
End Sub
Private Function B_Status(L As ListBox) As Boolean
    For i = 0 To L.ListCount - 1
          B_Status = B_Status Or L.Selected(i)
    Next
End Function

						