frmcellprint.frm

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

VERSION 5.00
Object = "{7802D41A-28B0-43C4-95EA-17B7E32337D1}#1.0#0"; "CellCtrl5.ocx"
Begin VB.Form frmcellprint 
   ClientHeight    =   4140
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6705
   LinkTopic       =   "Form1"
   ScaleHeight     =   4140
   ScaleWidth      =   6705
   StartUpPosition =   3  '窗口缺省
   Begin CELL50Lib.Cell Cll 
      Height          =   3975
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   6375
      _Version        =   65536
      _ExtentX        =   11245
      _ExtentY        =   7011
      _StockProps     =   0
   End
End
Attribute VB_Name = "frmcellprint"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim m_TitleTop As String
Dim m_HeadTop As String
Dim m_Width As String
Dim m_array() As String
Dim m_rSt As ADODB.Recordset
Dim m_Warray() As String

'属性

 '记录集
Public Property Let TableRst(ByVal rSt As ADODB.Recordset)
    Set m_rSt = New ADODB.Recordset
    m_rSt.CursorLocation = adUseClient
    Set m_rSt = rSt
End Property

'标题
Public Property Let TitleTop(ByVal tTop As String)
    m_TitleTop = tTop
End Property
'表头
Public Property Let HeadTop(ByVal hTop As String)
    m_HeadTop = hTop
End Property

'表头宽度
Public Property Let HeadWidth(ByVal hWidth As String)
   m_Width = hWidth
End Property

Public Sub cellprint()
Dim i As Integer
Dim j As Integer
Dim totalcols As Integer
cll.ShowHScroll True, 0
cll.ShowPageBreak flase
cll.ShowSideLabel flase, 0
cll.ShowTopLabel flase, 0
m_array() = Split(m_HeadTop, "|")
'存宽度
m_Warray() = Split(m_Width, "|")
totalcols = UBound(m_array) + 1
cll.SetCols totalcols + 1, 0
'对标题操作
cll.MergeCells 1, 1, totalcols + 1, 1
cll.SetCellString 1, 1, 0, m_TitleTop
cll.SetCellAlign 1, 1, 0, 32 + 4
cll.SetDefaultRowHeight 0, 1, 40
cll.SetCellFontSize 0, 1, 0, 23
cll.MergeCells 1, 2, 4, 2
cll.MergeCells 3, 2, 5, 2
   
'对表头操作
For i = 0 To UBound(m_array)
    cll.SetCellString i + 1, 4, 0, Trim(m_array(i))
    cll.SetCellAlign i + 1, 4, 0, 32 + 4
    cll.SetDefaultRowHeight 0, 1, 30
    cll.DrawGridLine i + 1, 4, i + 1, 4, 0, 2, -1
    cll.SetColWidth 1, m_Warray(i + 1), i + 1, 0
Next

'插入记录
cll.SetRows m_rSt.RecordCount + 3, 0
i = 4
Do Until m_rSt.EOF
   For j = 1 To UBound(m_array) + 1
        cll.SetCellString j, i + 1, 0, CStr(m_rSt.Fields(j - 1))
        cll.SetCellAlign j, i + 1, 0, 1
        cll.DrawGridLine j, i + 1, j, i + 1, 0, 2, -1
    Next
    m_rSt.MoveNext
    i = i + 1
Loop
cll.PrintSheet 0, 0
End Sub
Public Sub cllPrint()
cll.PrintSheet 1, 0
End Sub
Public Sub cllprivew()
cll.PrintPreview 1, 0
End Sub

Public Sub inti()
Dim i As Integer
Dim j As Integer
Dim totalcols As Integer
cll.ShowHScroll True, 0
cll.ShowPageBreak flase
cll.ShowSideLabel flase, 0
cll.ShowTopLabel flase, 0
'存宽度和表头
m_Warray() = Split(m_Width, "|")
m_array() = Split(m_HeadTop, "|")

totalcols = UBound(m_array) + 1
cll.SetCols totalcols + 1, 0
'对标题操作
cll.MergeCells 1, 1, totalcols + 1, 1
cll.SetCellString 1, 1, 0, m_TitleTop
cll.SetCellAlign 1, 1, 0, 32 + 4
cll.SetDefaultRowHeight 0, 1, 30
cll.SetCellFontSize 1, 1, 0, 16
   
'对表头操作
For i = 0 To UBound(m_array)
    cll.SetCellString i + 1, 4, 0, Trim(m_array(i))
    cll.SetCellAlign i + 1, 4, 0, 32 + 4
    cll.SetDefaultRowHeight 0, 1, 20
    cll.DrawGridLine i + 1, 3, i + 1, 4, 0, 2, -1
    cll.SetColWidth 1, m_Warray(i + 1), i + 1, 0
Next
'合并
cll.MergeCells 1, 2, 4, 2
cll.MergeCells 5, 2, 7, 2
'插入记录
cll.SetRows m_rSt.RecordCount + 4, 0
i = 4
m_rSt.MoveFirst
Do Until m_rSt.EOF
   For j = 1 To UBound(m_array) + 1
      If IsNull(Trim(m_rSt.Fields(j - 1))) Then
        cll.SetCellString j, i + 1, 0, ""
      Else
        cll.SetCellString j, i + 1, 0, CStr(Trim(m_rSt.Fields(j - 1)))
      End If
        cll.SetCellAlign j, i + 1, 0, 1
        cll.DrawGridLine j, i + 1, j, i + 1, 0, 2, -1
    Next
    m_rSt.MoveNext
    i = i + 1
Loop
cll.PrintSetTopTitle 1, 4
End Sub

Private Sub form_load()
   cll.Login "南京伊康计算机工程公司", "11010504", "0060-1733-7722-3004"
End Sub