frmcreatedatabasenewyear.frm

一个用VB写的财务软件源码

VERSION 5.00
Begin VB.Form frmCreateDatabaseNewYear 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "新建年度账"
   ClientHeight    =   2460
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3495
   Icon            =   "frmCreateDatabaseNewYear.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2460
   ScaleWidth      =   3495
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消(&C)"
      Height          =   315
      Left            =   2190
      TabIndex        =   2
      Top             =   2070
      Width           =   1005
   End
   Begin VB.CommandButton cmdOk 
      Caption         =   "确定(&O)"
      Height          =   315
      Left            =   330
      TabIndex        =   1
      Top             =   2070
      Width           =   1005
   End
   Begin VB.Frame fraInf 
      Height          =   1815
      Left            =   60
      TabIndex        =   0
      Top             =   60
      Width           =   3375
      Begin VB.PictureBox Picture3 
         Height          =   315
         Left            =   1290
         ScaleHeight     =   255
         ScaleWidth      =   1635
         TabIndex        =   5
         Top             =   1320
         Width           =   1695
         Begin VB.Label lblNewYear 
            AutoSize        =   -1  'True
            Caption         =   "xxxx"
            Height          =   180
            Left            =   60
            TabIndex        =   8
            Top             =   30
            Width           =   360
         End
      End
      Begin VB.PictureBox Picture2 
         Height          =   315
         Left            =   1290
         ScaleHeight     =   255
         ScaleWidth      =   1905
         TabIndex        =   4
         Top             =   810
         Width           =   1965
         Begin VB.Label lblAccountName 
            AutoSize        =   -1  'True
            Caption         =   "xxxx"
            Height          =   180
            Left            =   60
            TabIndex        =   7
            Top             =   30
            Width           =   360
         End
      End
      Begin VB.PictureBox Picture1 
         Height          =   315
         Left            =   1290
         ScaleHeight     =   255
         ScaleWidth      =   1905
         TabIndex        =   3
         Top             =   270
         Width           =   1965
         Begin VB.Label lblAccountManager 
            AutoSize        =   -1  'True
            Caption         =   "xxxx"
            Height          =   180
            Left            =   60
            TabIndex        =   6
            Top             =   60
            Width           =   360
         End
      End
      Begin VB.Label Label3 
         AutoSize        =   -1  'True
         Caption         =   "年"
         Height          =   180
         Left            =   3060
         TabIndex        =   12
         Top             =   1380
         Width           =   180
      End
      Begin VB.Label Label4 
         AutoSize        =   -1  'True
         Caption         =   "新建年份："
         Height          =   180
         Left            =   240
         TabIndex        =   11
         Top             =   1380
         Width           =   900
      End
      Begin VB.Label Label2 
         AutoSize        =   -1  'True
         Caption         =   "账套名称："
         Height          =   180
         Left            =   240
         TabIndex        =   10
         Top             =   840
         Width           =   900
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         Caption         =   "账套主管："
         Height          =   180
         Left            =   240
         TabIndex        =   9
         Top             =   330
         Width           =   900
      End
   End
End
Attribute VB_Name = "frmCreateDatabaseNewYear"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Option Base 1

Dim sNewYear As String                   '建新年度账的年份
Dim sBeginYear As String                 '账套启用年份
Dim sModiYear As String                  '账套结账年份
Dim sModiMonth As Integer                '账套结账月份
Dim adoRst As ADODB.Recordset
Dim adoSQL As String

Public usAccountID As String             '账套ID号
Public usAccountName As String           '账套名称

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdOk_Click()
    Dim bOK As Boolean              '是否创建成功
    If sBeginYear > sModiYear Then
        MsgBox usAccountName & "账套的账务子系统刚启用，不能新建年度账！", vbInformation
        Unload Me
        Exit Sub
    End If
    On Error GoTo errorhandle:
    If sModiMonth >= 11 Then
        If MsgBox("是否确认建立" & usAccountName & "账套的" & sNewYear & "年度的账？", _
            vbQuestion + vbYesNo + vbDefaultButton1) = vbYes Then
            Me.MousePointer = vbHourglass
            Call CreateDatabaseNewYear(bOK)
            Me.MousePointer = vbDefault
            If bOK Then
                With frmSelectPeriod
                    .usAccountID = usAccountID
                    .usNewYear = sNewYear
                    .Show 1
                    MsgBox usAccountName & "账套" & sNewYear & "年度账已经创建成功！", vbInformation
                End With
            Else
                MsgBox "因为人为终止或意外，" & usAccountName & "账套" & sNewYear & "年度账创建失败！", vbInformation
            End If
        End If
    Else
        MsgBox usAccountName & "账套账务子系统" & sModiYear & _
                "年会计工作还没有结账至11月份，不能新建下一年度账！", vbInformation
    End If
    Unload Me
    Exit Sub
errorhandle:
    MsgBox "创建年度账遇到意外情况，请与系统管理员联系！", vbInformation, "提示"
    Exit Sub
End Sub


Private Sub Form_Load()

    Set adoRst = New ADODB.Recordset
    adoRst.CursorLocation = adUseClient
    
    '从子系统启用表中取出当前账套的结账年份
    adoSQL = "SELECT * FROM tSYS_SubSysUsed" & _
            " WHERE AccountID = '" & usAccountID & _
            "' AND SubSysID = 'ZW'"
    With adoRst
        .Open adoSQL, gloSys.cnnSys, adOpenStatic, adLockReadOnly
        If .RecordCount > 0 Then
            sBeginYear = .Fields("BeginYear").Value
            sModiYear = .Fields("ModiYear").Value
            sModiMonth = .Fields("ModiMonth").Value
            '建新年度账的年份等于当前账套的结账年份+1
            sNewYear = sModiYear + 1
        End If
        .Close
    End With
    lblAccountManager.Caption = glo.sUserName
    lblAccountName.Caption = usAccountName
    lblNewYear.Caption = sNewYear
    
End Sub
'使用创建账套脚本早出含有年份的语句
Public Sub CreateYearTables(ByRef cnnORA As ADODB.Connection, ByVal sBeginYear As String)
    Dim sPath As String