setyear.frm

本人开发的商业财务软件

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form FsetYear 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "转结余额"
   ClientHeight    =   2370
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   6030
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2370
   ScaleWidth      =   6030
   ShowInTaskbar   =   0   'False
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   1440
      Top             =   1560
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton cmdBackup 
      Caption         =   "备份数据库"
      Height          =   375
      Left            =   4320
      TabIndex        =   3
      Top             =   720
      Width           =   1215
   End
   Begin VB.CommandButton CancelButton 
      Caption         =   "取消"
      Height          =   375
      Left            =   4320
      TabIndex        =   1
      Top             =   1440
      Width           =   1215
   End
   Begin VB.CommandButton OKButton 
      Caption         =   "余额结转"
      Height          =   375
      Left            =   4320
      TabIndex        =   0
      Top             =   1080
      Width           =   1215
   End
   Begin VB.Label Label2 
      Caption         =   "注意：设置年份以前应当把当年份的记帐凭证和明类分类帐全部打印完毕，并且注重保存备份文件。否则将给数据带来丢失！！"
      Height          =   615
      Left            =   240
      TabIndex        =   2
      Top             =   480
      Width           =   3735
   End
End
Attribute VB_Name = "FsetYear"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
Dim isBackup As Boolean

Private Sub CancelButton_Click()
    Unload Me
End Sub

Private Sub cmdBackup_Click()
    isBackup = DataBackup(CommonDialog1)
End Sub

Private Sub Form_Load()
    isBackup = False
End Sub
Private Sub OKButton_Click()
    If Not isBackup Then
        MsgBox "正在进行备份"
        isBackup = DataBackup(CommonDialog1)
        If isBackup Then
            MsgBox "备份成功,请注重保存备份文件"
            Else
            MsgBox " 备份失败，请得新备份"
        End If
    End If
    
    jieZhuang
    
    Unload Me
End Sub
Private Sub jieZhuang()
    Dim rsRemain As New ADODB.Recordset
    Dim rsKemu As New ADODB.Recordset
    Dim curRemain As Currency
    Dim rsMingXi As New ADODB.Recordset
    Dim strSql As String
    
    strSql = "select 科目,科目编号,日期,摘要,凭证号,借或贷,借方金额,贷方金额,余额 from mingxiZhang " _
            & "where 日期=#" & nYear & "/01/01#"
    rsMingXi.Open strSql, pubConn, adOpenDynamic, adLockOptimistic
    
    
    
    rsKemu.Open "select 科目,借贷,编号 from kemu", pubConn
    rsKemu.MoveFirst
    Do Until rsKemu.EOF
        strSql = "select 余额 from mingxiZhang where 科目='" & rsKemu!科目 _
                & "' and 凭证号 in( select max(凭证号) from mingxiZhang where " _
                & " 科目='" & rsKemu!科目 & "')"
        rsRemain.Open strSql, pubConn
        If rsRemain.BOF And rsRemain.EOF Then
            MsgBox "本科目明细帐不存在", , "出错"
            curRemain = 0
        Else
            curRemain = rsRemain!余额
        End If
        
        rsMingXi.AddNew
        rsMingXi!科目 = rsKemu!科目
        rsMingXi!科目编号 = rsKemu!编号
        rsMingXi!借或贷 = rsKemu!借贷
        rsMingXi!凭证号 = 0
        rsMingXi!日期 = CDate(Str(nYear + 1) & "/01/01")
        rsMingXi!摘要 = "期初余额"
        
        If rsKemu!借贷 = "借" Then
            rsMingXi!借方金额 = curRemain
            rsMingXi!贷方金额 = 0
        Else
            rsMingXi!借方金额 = 0
            rsMingXi!贷方金额 = curRemain
        End If
        
        rsMingXi.Update
        rsRemain.Close
        rsKemu.MoveNext
    Loop
    Set rsRemain = Nothing
    rsKemu.Close
    rsMingXi.Close
    
    
    pubConn.Execute "delete * from pingZheng"
    pubConn.Execute "delete * from pingZhengFx"
    pubConn.Execute "delete * from mingxiZhang where 日期 <> #" & Str(nYear + 1) & "-01-01#"
    pubConn.Close
    
    initApp
    
End Sub