showmingxi.frm

本人开发的商业财务软件

VERSION 5.00
Object = "{F0D2F211-CCB0-11D0-A316-00AA00688B10}#1.0#0"; "MSDATLST.OCX"
Object = "{0ECD9B60-23AA-11D0-B351-00A0C9055D8E}#6.0#0"; "MSHFLXGD.OCX"
Begin VB.Form ShowMingXi 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "显示明细分类帐"
   ClientHeight    =   5955
   ClientLeft      =   2760
   ClientTop       =   3750
   ClientWidth     =   8895
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5955
   ScaleWidth      =   8895
   ShowInTaskbar   =   0   'False
   Begin VB.CommandButton cmdPrint 
      Caption         =   "打印"
      Height          =   375
      Left            =   7200
      TabIndex        =   4
      Top             =   120
      Width           =   1095
   End
   Begin MSDataListLib.DataCombo FxKemu 
      Height          =   330
      Left            =   1080
      TabIndex        =   3
      Top             =   120
      Width           =   3495
      _ExtentX        =   6165
      _ExtentY        =   582
      _Version        =   393216
      IntegralHeight  =   0   'False
      Text            =   ""
   End
   Begin MSHierarchicalFlexGridLib.MSHFlexGrid MSHFlexGrid1 
      Height          =   5175
      Left            =   0
      TabIndex        =   1
      Top             =   720
      Width           =   8895
      _ExtentX        =   15690
      _ExtentY        =   9128
      _Version        =   393216
      _NumberOfBands  =   1
      _Band(0).Cols   =   2
   End
   Begin VB.CommandButton OKButton 
      Caption         =   "关闭"
      Height          =   375
      Left            =   5280
      TabIndex        =   0
      Top             =   120
      Width           =   1215
   End
   Begin VB.Label Label1 
      Caption         =   "科目"
      Height          =   255
      Left            =   240
      TabIndex        =   2
      Top             =   120
      Width           =   375
   End
End
Attribute VB_Name = "ShowMingXi"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim rstKemu As New ADODB.Recordset
Dim rstMingxi As New ADODB.Recordset
Dim strFxKemu

Private Sub cmdPrint_Click()
    Dim mobjExcel As Excel.Application
    Dim mobjworkbook As Excel.Workbook
    Dim xlsheet As Excel.Worksheet
    Dim rstPingZheng As New ADODB.Recordset
    Dim strDestination, strSource As String
    Dim iLine As Integer
    Dim nPage As Integer
    Dim i As Integer
    nPage = 1
    Dim iCol As Integer
    Dim curTemp As Currency
    Dim DebitSum As Currency
    Dim CreditSum As Currency
    DebitSum = 0
    CreditSum = 0
    Dim iNumRec As Long '记录个数 ，按整页计算，表格行数用
    Dim fxSum(12) As Currency
   ' rstMingxi.CursorLocation = adUseClient
    For i = 0 To 11
        fxSum(i) = 0
    Next i
    If Left(FxKemu.BoundText, 3) <> "201" Then
        strSource = App.Path & "\mingxi1.xls"
    Else
        strSource = App.Path & "\mingxi.xls"
    End If
    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)
    rstMingxi.MoveFirst
    '填充凭证数据
    If Left(FxKemu.BoundText, 3) <> "201" Then
    '没有分析科目的明细分类帐的打印
        If (rstMingxi.RecordCount + 1) Mod 19 = 0 Then
            iNumRec = rstMingxi.RecordCount + 1
        Else
            iNumRec = ((rstMingxi.RecordCount + 1) \ 19) * 19 + 19
        End If
        '画边框
                mobjExcel.ActiveSheet.Range(mobjExcel.ActiveSheet.Cells(6, 1), mobjExcel.ActiveSheet.Cells(iNumRec + 5, 11)).Select
                With mobjExcel.Selection.Borders
                    .LineStyle = xlContinuous
                End With
        

        mobjExcel.ActiveSheet.Cells(2, 4).Value = FxKemu.Text '科目名称
      '  mobjExcel.ActiveSheet.Cells(2, 9).Value = nPage '页码
        iLine = 6
        Do Until rstMingxi.EOF
            mobjExcel.ActiveSheet.Cells(iLine, 1).Value = Month(rstMingxi!日期)
            mobjExcel.ActiveSheet.Cells(iLine, 2).Value = Day(rstMingxi!日期)
            mobjExcel.ActiveSheet.Cells(iLine, 3).Value = rstMingxi!月凭证号
            mobjExcel.ActiveSheet.Cells(iLine, 5).Value = rstMingxi!摘要
            mobjExcel.ActiveSheet.Cells(iLine, 9).Value = rstMingxi!借或贷
            mobjExcel.ActiveSheet.Cells(iLine, 10).Value = rstMingxi!余额
            If Not IsNull(rstMingxi!借方金额) Then
                '如果借方金额为空
                If rstMingxi!借方金额 <> 0 Then
                    mobjExcel.ActiveSheet.Cells(iLine, 7).Value = rstMingxi!借方金额
                    If (rstMingxi!凭证号 <> 0) Then
                        DebitSum = DebitSum + rstMingxi!借方金额
                    End If
                End If
            End If
            
            If Not IsNull(rstMingxi!贷方金额) Then
                If rstMingxi!贷方金额 <> 0 Then
                    mobjExcel.ActiveSheet.Cells(iLine, 8).Value = rstMingxi!贷方金额
                    If (rstMingxi!凭证号 <> 0) Then
                        CreditSum = CreditSum + rstMingxi!贷方金额
                    End If
                End If
            End If
            
            iLine = iLine + 1
            rstMingxi.MoveNext
        Loop

        mobjExcel.ActiveSheet.Cells(iLine, 5).Value = "合计"
        mobjExcel.ActiveSheet.Cells(iLine, 7).Value = Format(DebitSum, "0.00")
        mobjExcel.ActiveSheet.Cells(iLine, 8).Value = Format(CreditSum, "0.00")
    Else
    '有分析科目的明细分类帐打印
        If (rstMingxi.RecordCount + 1) Mod 19 = 0 Then
            iNumRec = rstMingxi.RecordCount + 1
        Else
            iNumRec = ((rstMingxi.RecordCount + 1) \ 19) * 19 + 19
        End If
        
        '画边框
                mobjExcel.ActiveSheet.Range(mobjExcel.ActiveSheet.Cells(7, 1), mobjExcel.ActiveSheet.Cells(iNumRec + 6, 20)).Select
                With mobjExcel.Selection.Borders
                    .LineStyle = xlContinuous
                End With

        mobjExcel.ActiveSheet.Cells(3, 2).Value = FxKemu.Text '科目名称
        iLine = 7
        Do Until rstMingxi.EOF
            mobjExcel.ActiveSheet.Cells(iLine, 1).Value = Month(rstMingxi!日期)
            mobjExcel.ActiveSheet.Cells(iLine, 2).Value = Day(rstMingxi!日期)
            mobjExcel.ActiveSheet.Cells(iLine, 3).Value = rstMingxi!月凭证号
            mobjExcel.ActiveSheet.Cells(iLine, 4).Value = rstMingxi!摘要
            mobjExcel.ActiveSheet.Cells(iLine, 7).Value = rstMingxi!借或贷
            mobjExcel.ActiveSheet.Cells(iLine, 8).Value = rstMingxi!余额
            
            If Not IsNull(rstMingxi!借方金额) Then
                '如果借方金额为空
                If rstMingxi!借方金额 <> 0 Then
                    mobjExcel.ActiveSheet.Cells(iLine, 5).Value = rstMingxi!借方金额
                    If (rstMingxi!凭证号 <> 0) Then
                        DebitSum = DebitSum + rstMingxi!借方金额
                    End If
                End If
            End If
            
            If Not IsNull(rstMingxi!贷方金额) Then
                If rstMingxi!贷方金额 <> 0 Then
                    mobjExcel.ActiveSheet.Cells(iLine, 6).Value = rstMingxi!贷方金额
                    If (rstMingxi!凭证号 <> 0) Then
                        CreditSum = CreditSum + rstMingxi!贷方金额
                    End If
                End If
            End If
            
            
              
            For i = 0 To 11
                If Not IsNull(rstMingxi(strFxKemu(i))) Then
                    If rstMingxi(strFxKemu(i)) <> 0 Then
                    mobjExcel.ActiveSheet.Cells(iLine, 9 + i).Value = rstMingxi(strFxKemu(i))
                    If (rstMingxi!凭证号 <> 0) Then
                        fxSum(i) = fxSum(i) + rstMingxi(strFxKemu(i))
                    End If
                    End If
                End If
            Next i
            
             
            iLine = iLine + 1
            rstMingxi.MoveNext
        Loop
        mobjExcel.ActiveSheet.Cells(iLine, 4).Value = "合计"
        mobjExcel.ActiveSheet.Cells(iLine, 5).Value = Format(DebitSum, "0.00")
        mobjExcel.ActiveSheet.Cells(iLine, 6).Value = Format(CreditSum, "0.00")
        For i = 0 To 11
            If fxSum(i) <> 0 Then
                mobjExcel.ActiveSheet.Cells(iLine, 9 + i).Value = Format(fxSum(i), "0.00")
            End If
        Next i


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

Private Sub Form_Load()
    rstKemu.CursorLocation = adUseClient
    rstKemu.Open "select 科目,编号 from kemu order by 编号", pubConn
    Set FxKemu.DataSource = rstKemu
    Set FxKemu.RowSource = rstKemu
    FxKemu.ListField = "科目"
    FxKemu.BoundColumn = "编号"
    rstMingxi.CursorLocation = adUseClient
    strFxKemu = Array("个人部分", "办公费", "交通费", "水电费", "邮电费", "招待费", "购置费", "宣培费", "手术补助", "差旅费", "业务费", "其它")
End Sub
Private Sub Form_Unload(Cancel As Integer)
    rstKemu.Close
    If rstMingxi.State = adStateOpen Then
        rstMingxi.Close
    End If
End Sub

Private Sub FxKemu_Change()
    Dim strSql As String
    
    If FxKemu.Text = "" Then
        Exit Sub  '如果没有选中科目则退出本函数
    End If
    If rstMingxi.State = adStateOpen Then
        rstMingxi.Close '如果记集打开则关闭它
    End If
    If Left(FxKemu.BoundText, 3) <> "201" Then
        strSql = "select 日期,凭证号,月凭证号,摘要,借方金额,贷方金额,借或贷,余额 from  MingXiZhang  where 科目编号='" & FxKemu.BoundText & "' order by 凭证号"
    Else
        strSql = " select 日期,凭证号,月凭证号,摘要,借方金额,贷方金额,借或贷,余额,个人部分,办公费,交通费,水电费,邮电费,招待费,购置费,宣培费," _
            & "手术补助,差旅费,业务费,其它 from  MingXiZhang  where 科目编号='" _
            & FxKemu.BoundText & "' order by 凭证号"
    End If
    rstMingxi.Open strSql, pubConn
    Set MSHFlexGrid1.DataSource = rstMingxi
End Sub
Private Sub OKButton_Click()
    Unload Me
End Sub