dlgbalance.frm

本人开发的商业财务软件

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{0ECD9B60-23AA-11D0-B351-00A0C9055D8E}#6.0#0"; "MSHFLXGD.OCX"
Begin VB.Form dlgBalance 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "显示科目余额"
   ClientHeight    =   5205
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   6465
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5205
   ScaleWidth      =   6465
   ShowInTaskbar   =   0   'False
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   1800
      Top             =   1560
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.CommandButton Command1 
      Caption         =   "导出Excel文件"
      Height          =   375
      Left            =   3000
      TabIndex        =   3
      Top             =   0
      Width           =   1695
   End
   Begin VB.CommandButton cmdPrintBalance 
      Caption         =   "打印余额表"
      Height          =   375
      Left            =   1680
      TabIndex        =   2
      Top             =   0
      Width           =   1215
   End
   Begin MSHierarchicalFlexGridLib.MSHFlexGrid Grid1 
      Height          =   4695
      Left            =   0
      TabIndex        =   1
      Top             =   480
      Width           =   6255
      _ExtentX        =   11033
      _ExtentY        =   8281
      _Version        =   393216
      Rows            =   1
      Cols            =   4
      FixedRows       =   0
      AllowUserResizing=   3
      RowSizingMode   =   1
      _NumberOfBands  =   1
      _Band(0).Cols   =   4
      _Band(0).GridLinesBand=   1
      _Band(0).TextStyleBand=   0
      _Band(0).TextStyleHeader=   0
   End
   Begin VB.CommandButton OKButton 
      Caption         =   "离开"
      Height          =   375
      Left            =   5040
      TabIndex        =   0
      Top             =   0
      Width           =   1215
   End
End
Attribute VB_Name = "dlgBalance"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'李树永 QQ 82341763
'Email:[e-mail]
Option Explicit
    Dim rsRemain As New ADODB.Recordset
    Dim rsKemu As New ADODB.Recordset
    Dim strSql As String
    Dim strItem As String


Private Sub cmdPrintBalance_Click()
    Dim rKemu As New ADODB.Recordset
    Dim mobjExcel As Excel.Application
    Dim mobjworkbook As Excel.Workbook
    Dim xlsheet As Excel.Worksheet
    Dim rstPingZheng As New ADODB.Recordset
    Dim strDestination As String, strSource As String
    Dim curRemain As Currency
    Dim strSql As String 'sql命令
    Dim iLine As Integer, iCol As Integer
    Dim i As Integer '临时变量
    
    
    strSource = App.Path & "\templet\balance.xls"
    strDestination = App.Path & "\temp\科目余额表.xls"
    If Dir(strDestination) <> "" Then Kill strDestination
    FileCopy strSource, strDestination
    Set mobjExcel = New Excel.Application
    Set mobjExcel = CreateObject("Excel.Application")
    mobjExcel.Visible = True
    Set mobjworkbook = mobjExcel.Workbooks.Open(strDestination)
    Set xlsheet = mobjworkbook.Worksheets(1)
    
    rKemu.CursorLocation = adUseClient
    rKemu.Open "select 编号,科目 from kemu   order by 编号", pubConn, adOpenDynamic, adLockOptimistic
    
    '填充应付款抚养费栏目
    i = 0
    iLine = 4
    iCol = 15
    rKemu.MoveFirst
    Do Until rKemu.EOF
        
        If Left(rKemu!编号, 6) = "201100" Then
           strSql = "select 余额 from mingxiZhang where 科目='" & rKemu!科目 _
                 & "' and 凭证号 in( select max(凭证号) from mingxiZhang where " _
                 & " 科目='" & rKemu!科目 & "')"
            rsRemain.Open strSql, pubConn
            If rsRemain.BOF And rsRemain.EOF Then
                MsgBox "本科目明细帐不存在", , "出错"
                curRemain = 0
            Else
                curRemain = rsRemain!余额
            End If
        
            mobjExcel.ActiveSheet.Cells(iLine + i, iCol).Value = Format(curRemain, "0.00")
            i = i + 1
            rsRemain.Close
        End If
        rKemu.MoveNext
    Loop
    
    '填充应抚款抚养费栏数据
    i = 0
    iLine = 4
    iCol = 2
    rKemu.MoveFirst
    Do Until rKemu.EOF
        
        If Left(rKemu!编号, 6) = "201300" Then
           strSql = "select 余额 from mingxiZhang where 科目='" & rKemu!科目 _
                 & "' and 凭证号 in( select max(凭证号) from mingxiZhang where " _
                 & " 科目='" & rKemu!科目 & "')"
            rsRemain.Open strSql, pubConn
            If rsRemain.BOF And rsRemain.EOF Then
                MsgBox "本科目明细帐不存在", , "出错"
                curRemain = 0
            Else
                curRemain = rsRemain!余额
            End If
        
            mobjExcel.ActiveSheet.Cells(iLine + i, iCol).Value = Format(curRemain, "0.00")
            i = i + 1
            rsRemain.Close
        End If
        rKemu.MoveNext
    Loop
    
    '填充应抚款技术栏数据
    i = 0
    iLine = 4
    iCol = 10
    rKemu.MoveFirst
    Do Until rKemu.EOF
        
        If Left(rKemu!编号, 6) = "201200" Then
           strSql = "select 余额 from mingxiZhang where 科目='" & rKemu!科目 _
                 & "' and 凭证号 in( select max(凭证号) from mingxiZhang where " _
                 & " 科目='" & rKemu!科目 & "')"
            rsRemain.Open strSql, pubConn
            If rsRemain.BOF And rsRemain.EOF Then
                MsgBox "本科目明细帐不存在", , "出错"
                curRemain = 0
            Else
                curRemain = rsRemain!余额
            End If
        
            mobjExcel.ActiveSheet.Cells(iLine + i, iCol).Value = Format(curRemain, "0.00")
            i = i + 1
            rsRemain.Close
        End If
        rKemu.MoveNext
    Loop
'合计收款项
    Dim cSum As Currency
    cSum = 0
    i = 0
    iLine = 28
    iCol = 15
    rKemu.MoveFirst
    Do Until rKemu.EOF
        
        If Left(rKemu!编号, 4) = "1010" Then
           strSql = "select 余额 from mingxiZhang where 科目='" & rKemu!科目 _
                 & "' and 凭证号 in( select max(凭证号) from mingxiZhang where " _
                 & " 科目='" & rKemu!科目 & "')"
            rsRemain.Open strSql, pubConn
            If rsRemain.BOF And rsRemain.EOF Then
                MsgBox "本科目明细帐不存在", , "出错"
                curRemain = 0
            Else
                curRemain = rsRemain!余额
            End If
            i = i + 1
            cSum = cSum + curRemain
            rsRemain.Close
        End If
        rKemu.MoveNext
    Loop
    mobjExcel.ActiveSheet.Cells(iLine, iCol).Value = Format(cSum, "0.00")
    
    '银行存款
               strSql = "select 余额 from mingxiZhang where 科目='银行存款" _
                 & "' and 凭证号 in( select max(凭证号) from mingxiZhang where " _
                 & " 科目='银行存款')"
            rsRemain.Open strSql, pubConn
            If rsRemain.BOF And rsRemain.EOF Then
                MsgBox "本科目明细帐不存在", , "出错"
                curRemain = 0
            Else
                curRemain = rsRemain!余额
            End If
            mobjExcel.ActiveSheet.Cells(28, 10).Value = Format(curRemain, "0.00")
            
            rsRemain.Close

    
    '财政代管余额
            strSql = "select 余额 from mingxiZhang where 科目='应收款-财政代管资金" _
                 & "' and 凭证号 in( select max(凭证号) from mingxiZhang where " _
                 & " 科目='应收款-财政代管资金')"
            rsRemain.Open strSql, pubConn
            If rsRemain.BOF And rsRemain.EOF Then
                MsgBox "本科目明细帐不存在", , "出错"
                curRemain = 0
            Else
                curRemain = rsRemain!余额
            End If
            mobjExcel.ActiveSheet.Cells(28, 1).Value = Format(curRemain, "0.00")
            
            rsRemain.Close

 
    '利息
            strSql = "select 余额 from mingxiZhang where 科目='应付款-利息" _
                 & "' and 凭证号 in( select max(凭证号) from mingxiZhang where " _
                 & " 科目='应付款-利息')"
            rsRemain.Open strSql, pubConn
            If rsRemain.BOF And rsRemain.EOF Then
                MsgBox "本科目明细帐不存在", , "出错"
                curRemain = 0
            Else
                curRemain = rsRemain!余额
            End If
            mobjExcel.ActiveSheet.Cells(25, 2).Value = Format(curRemain, "0.00")
            
            rsRemain.Close

    
     '打印预览
    xlsheet.PrintPreview
    'mobjworkbook.PrintPreview
    mobjworkbook.Save
   ' mobjworkbook.Quit
    mobjExcel.Quit
    Set mobjworkbook = Nothing
    Set mobjExcel = Nothing

End Sub

Private Sub Command1_Click()
    Dim sFile As String
    Dim sFile1 As String
    sFile = "科目余额表.xls"
    With CommonDialog1
        .DialogTitle = "导出到目录"
        .CancelError = False
        'ToDo: 设置 common dialog 控件的标志和属性
        .Filter = "Excel文件 (*.xls)|*.xls"
        .FileName = sFile
        .ShowSave
        sFile = .FileName
    End With
    sFile1 = App.Path & "\temp\科目余额表.xls"
    
    FileCopy sFile1, sFile
  '  Shell "start " & sFile
End Sub

Private Sub Form_Load()

    Dim curRemain As Currency
    rsKemu.Open "select 科目,借贷,编号 from kemu order by 编号", pubConn
    rsKemu.MoveFirst
    Grid1.ColWidth(1) = 2400
    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
        strItem = "" & Chr(9) & rsKemu!科目 & Chr(9) & rsKemu!借贷 & Chr(9) & CStr(curRemain)
        Grid1.AddItem strItem
        rsRemain.Close
        rsKemu.MoveNext
    Loop

    rsKemu.Close
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set rsRemain = Nothing
    Set rsKemu = Nothing
End Sub

Private Sub OKButton_Click()
    Unload Me
End Sub