Friend Class CExcelReport
Inherits CPublicExcel
Public Structure Font
Dim Name As String
Dim Size As Integer
Dim ForeColor As Integer
Dim Bold As Boolean '
Dim Italic As Boolean
Dim Underline As Boolean
Sub init()
Name = "宋体"
Size = 12
ForeColor = RGB(0, 0, 0)
Bold = False
Italic = False
Underline = False
End Sub
End Structure
Public Structure Cell
Dim Row As Integer '位置
Dim Col As Integer
Dim value As String '文本
Dim MergeCells As Boolean '单元格合并
Dim LineType As Integer '边线类型
Dim LineWeight As Integer 'xlHairline、xlThin细、xlMedium中等 xlThick
粗Long 类型。
Dim InsideWeight As Integer
Dim Pattern As Integer '填充
Dim Background As Integer
'Dim ForeColor As Integer '
Dim Alignment As Integer '对齐
Dim InsideHorizontal As Integer '边框内水平线线类型
Dim InsideVertical As Integer '边框内竖线线类型
Dim ItemFont As Font
Sub init()
MergeCells = False
LineType = xlContinuous
LineWeight = xlMedium
InsideWeight = xlThin
Pattern = xlPatternAutomatic
Background = 0
Alignment = xlCenter
InsideVertical = xlContinuous
InsideHorizontal = xlContinuous
End Sub
End Structure
Public Structure IsPrint
Dim Text As String
Dim IsPrint As Boolean '是否打印
Dim PrintPostion As Integer '打印位置
Dim Landscape As Excel.XlPageOrientation '打印方向 '.xlLandscape
Sub init()
Landscape = Excel.XlPageOrientation.xlPortrait
End Sub
End Structure
Public Structure Excels
Dim StartRow As Int16
Dim StartCol As Integer
Dim MainTitle As Cell '主
Dim SubTitle As Cell '副
Dim GridHeads() As Cell '网格的头（表头）
Dim GridBodys( As Cell '网格的单元格（表体)
'网格类型(为了不再区分网格类型而设置)
Dim CellColWidthS() As Integer '换算后的列宽
Dim GridColCount As Integer '网格列数(由选择的不同于改变)
Dim GridRowCount As Integer '网格行数
Dim IsTime As IsPrint '打印时间
Dim IsPage As IsPrint '打印页码
Dim IsPeople As IsPrint '打印人
Dim FileType As Integer
End Structure
'开始行列位置
Const START_ROW = 0
Const START_COL = 0
'公有数据
Public MainTitle As String '文件的大标题--一般为"**学校**系统"
Public SubTitle As String
'文件的次标题--一般为要打印的窗体的title
'私有数据，内部使用
Private mDataTable As DataTable '要打印的数据网格控件
Private mObject As Object '要打印的对象
Private blnFillSheet As Boolean '是否已经填充了数据
第一次要填充，以后不要'填充 否则速度慢
Public Data As Excels 'excelS的单元数据
Public Property DataTable() As DataTable
Get
DataTable = mDataTable
End Get
Set(ByVal Value As DataTable)
mDataTable = Value
End Set
End Property
'初使化类(计算行列数，填充数据)
Private Sub InitExcelData()
Dim i, j As Int16
Data.GridColCount = mDataTable.Columns.Count
Data.GridRowCount = mDataTable.Rows.Count
'根据实际行列数重新定义数组
ReDim Data.CellColWidthS(Data.GridColCount - 1)
ReDim Data.GridHeads(Data.GridColCount - 1)
ReDim Data.GridBodys(Data.GridRowCount - 1, Data.GridColCount - 1)
'网格头：填充数据
For i = 0 To Data.GridColCount - 1
'Select Case aa
' Case ""
' Case ""
' Case ""
'End Select
Data.CellColWidthS(i) = 60
Data.GridHeads(i).value = mDataTable.Columns(i).Caption
Next
'网格体：填充数据
For i = 0 To Data.GridRowCount - 1
For j = 0 To Data.GridColCount - 1
If Not IsDBNull(mDataTable.Rows(i).Item(j)) Then
Data.GridBodys(i, j).value = mDataTable.Rows(i).Item(j)
End If
Next
Next
End Sub
'初使化类
Public Sub InitExcel()
Dim i, j As Int16
'主标题：坐标（START_ROW，START_COL），值（MainTitle），线型，字体
With Data.MainTitle
.init()
.Row = START_ROW
.Col = START_COL
.value = MainTitle
.MergeCells = True
.LineType = xlLineStyleNone '边线类型
实线xlDash虚线、xlDashDot点虚线、xlDashDotDot、xlDot点线、xlDouble双线、xlSlantDashDot斜线
或 xlLineStyleNone无线
.Background = 6
With .ItemFont
.init()
.Size = 20
.Bold = True
End With
End With
'副标题：坐标（START_ROW+2，START_COL），值（SubTitle），线型，字体
With Data.SubTitle
.init()
.Row = START_ROW + 2
.Col = START_COL
.value = SubTitle
.MergeCells = True
.LineType = xlLineStyleNone '边线类型
实线xlDash虚线、xlDashDot点虚线、xlDashDotDot、xlDot点线、xlDouble双线、xlSlantDashDot斜线
或 xlLineStyleNone无线
With .ItemFont
.init()
.Size = 12
End With
End With
InitExcelData()
'网格头：填充坐标（START_ROW+4，START_COL+1+i），线型，字体
For i = 0 To Data.GridColCount - 1
With Data.GridHeads(i)
.init()
.Row = START_ROW + 4
.Col = START_COL + i
'.LineType = xlContinuous
'.InsideVertical = xlContinuous
With .ItemFont
.init()
.Bold = True
' .Size = 9
End With
End With
Next
' .LineWeight = xlHairline 'xlHairline、xlThin、xlMedium 中等或
xlThick。
'网格体：先填充坐标（START_ROW+4，START_COL+1+i），线型，字体
For i = 0 To Data.GridRowCount - 1
For j = 0 To Data.GridColCount - 1
With Data.GridBodys(i, j)
.init()
.Row = START_ROW + 5 + i
.Col = START_COL + j
'.LineType = xlContinuous
'.LineWeight = xlThin
'.InsideHorizontal = xlContinuous
With .ItemFont
.init()
'.Size = 9
End With
End With
Next
Next
Data.IsPage.init()
End Sub
'这个属性来设定要打印的数据表
' Public Property DataTableName() As DataTable
' Get
' DataTableName = mDataTable
' End Get
' Set(ByVal Value As DataTable)
' mDataTable = Value
' End Set
'End Property
'由Cell:主标题，子标题，网格头，网格体填充单元格数据
Private Sub FillCellValue(ByVal Item As Cell)
Dim row, col As Int16
row = Item.Row + 1
col = Item.Col + 1
xlApp.Cells(row, col) = Item.value '值
With xlApp.Cells(row, col)
'.Clear
'.ColumnWidth = Data.CellColWidthS(Item.Col)
.ShrinkToFit = True
.NumberFormatLocal = "@"
End With
End Sub
'由Cell:主标题，子标题，网格头，网格体填充单元格字体
Public Sub SetCellFont(ByVal ThisCell As Cell)
Dim row, col As Int16
row = ThisCell.Row + 1
col = ThisCell.Col + 1
With xlApp
.Range(.Cells(row, col), .Cells(row, col + Data.GridColCount -
1)).Select()
With .Selection.font
.Name = ThisCell.ItemFont.Name
.Color = ThisCell.ItemFont.ForeColor
.Size = ThisCell.ItemFont.Size
.Underline = ThisCell.ItemFont.Underline
.Bold = ThisCell.ItemFont.Bold
.Italic = ThisCell.ItemFont.Italic
End With
End With
Exit Sub
End Sub
' 这个子程序是用来设置Excel中指定范围的单元的Border的
Public Sub SetExcelBorde(ByVal ThisCell As Cell)
Dim Row, Col As Integer
Row = ThisCell.Row + 1
Col = ThisCell.Col + 1
With xlApp
.Range(.Cells(Row, Col), .Cells(Row, Col + Data.GridColCount -
1)).Select()
With .Selection
.MergeCells = ThisCell.MergeCells '合并单元格
.Interior.ColorIndex = ThisCell.Background '背景色
.Interior.Pattern = ThisCell.Pattern '背景填充图案
.Borders.Weight = ThisCell.LineWeight '
.Borders.LineStyle = ThisCell.LineType '范围内的边线
.HorizontalAlignment = ThisCell.Alignment '水平对齐方式
'.VerticalAlignment = ThisCell.Alignment
'说明：只有范围内有竖线是可设.Borders(xlInsideVertical).LineStyle
If DataTable.Columns.Count > 1 Then
.Borders(xlInsideVertical).LineStyle =
ThisCell.InsideVertical '
If ThisCell.InsideVertical <> xlLineStyleNone Then
.Borders(xlInsideVertical).Weight = ThisCell.InsideWeight
End If
End If
'.RowHeight = 30
End With
End With
End Sub
' 这个子程序是用来设置Excel中Font指定范围的单元的Border的
Public Sub SetExcelFontBorde(ByVal ThisCell As Cell)
Dim Row, Col As Integer
Row = ThisCell.Row + 1
Col = ThisCell.Col + 1
With xlApp
' .Range(.Cells(Row, Col), .Cells(Row, Col + Data.GridColCount -
1)).Select()
.Range(.Cells(Row, Col), .Cells(Data.GridBodys(Data.GridRowCount - 1,
Data.GridColCount - 1).Row + 1, Data.GridBodys(Data.GridRowCount - 1,
Data.GridColCount - 1).Col + 1)).Select()
With .Selection
'.MergeCells = ThisCell.MergeCells '合并单元格
.Interior.ColorIndex = ThisCell.Background '背景色
.Interior.Pattern = ThisCell.Pattern '背景填充图案
.Borders.Weight = ThisCell.LineWeight '
.Borders.LineStyle = ThisCell.LineType '范围内的边线
.HorizontalAlignment = ThisCell.Alignment '水平对齐方式
'.VerticalAlignment = ThisCell.Alignment
'说明：只有范围内有竖线是可设.Borders(xlInsideVertical).LineStyle
If DataTable.Columns.Count > 1 Then
.Borders(xlInsideVertical).LineStyle =
ThisCell.InsideVertical '
If ThisCell.InsideVertical <> xlLineStyleNone Then
.Borders(xlInsideVertical).Weight = ThisCell.InsideWeight
'
End If
End If
'说明：只有范围内有水平线是可设Borders(xlInsideHorizontal).LineStyle
If ThisCell.InsideHorizontal <> -1 And Data.GridRowCount > 1 Then
.Borders(xlInsideHorizontal).LineStyle =
ThisCell.InsideHorizontal
If ThisCell.InsideHorizontal <> xlLineStyleNone Then
.Borders(xlInsideHorizontal).Weight =
ThisCell.InsideWeight '
End If
End If
'.RowHeight = 30
End With
End With
End Sub
'设置打印页，在打印页的适当位置（用户控制）插入页码，日期，单位等。
Public Sub SetPage()
Dim strDataTop As String
Dim strDataButtom As String
If Data.IsPage.IsPrint = True Then
If Data.IsPage.PrintPostion = 0 Then
strDataTop = "第 &P 页，共 &N 页"
Else
strDataButtom = "第 &P 页，共 &N 页"
End If
End If
If Data.IsTime.IsPrint = True Then
If Data.IsTime.PrintPostion = 0 Then
strDataTop = strDataTop + " " + "&D "
Else
strDataButtom = strDataButtom + " " + "&D "
End If
End If
If Data.IsPeople.IsPrint = True Then
If Data.IsPeople.PrintPostion = 0 Then
strDataTop = strDataTop + " " + Data.IsPeople.Text
Else
strDataButtom = strDataButtom + " " + Data.IsPeople.Text
End If
End If
With xlApp.ActiveSheet.PageSetup
xlApp.Range(xlApp.Cells(Data.MainTitle.Row + 1, Data.MainTitle.Col +
1), xlApp.Cells(Data.GridBodys(Data.GridRowCount - 1,
Data.GridColCount - 1).Row + 1, Data.GridBodys(Data.GridRowCount - 1,
Data.GridColCount - 1).Col + 1)).Select()
.CenterHeader = strDataTop
.CenterFooter = strDataButtom
.CenterHorizontally = True
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.Orientation = Data.IsPage.Landscape
End With
End Sub
'填充主标题
Public Sub FillMainTitle()
FillCellValue(Data.MainTitle)
SetCellFont(Data.MainTitle)
SetExcelBorde(Data.MainTitle)
End Sub
'填充子标题
Public Sub FillSubTitle()
FillCellValue(Data.SubTitle)
SetCellFont(Data.SubTitle)
SetExcelBorde(Data.SubTitle)
End Sub
'填充网格头
Public Sub FillGridHead()
Dim i As Integer
For i = 0 To Data.GridColCount - 1
FillCellValue(Data.GridHeads(i))
Next
SetCellFont(Data.GridHeads(0))
SetExcelBorde(Data.GridHeads(0))
End Sub
'填充网格体
Public Sub FillGridBody()
'xlApp.Range("A1").CopyFromRecordset()
Dim i, j As Integer
For i = 0 To Data.GridRowCount - 1 '
For j = 0 To Data.GridColCount - 1
FillCellValue(Data.GridBodys(i, j))
Next
Next
For i = 0 To Data.GridRowCount - 1 '
SetCellFont(Data.GridBodys(i, 0))
Next
SetExcelFontBorde(Data.GridBodys(0, 0))
End Sub
'向Excel表中添加数据并分别设置
Public Sub FillExcelSheet()
Call FillMainTitle()
Call FillSubTitle()
Call FillGridHead()
Call FillGridBody()
blnFillSheet = True
End Sub
'打印Excel
Public Sub PrintExcel()
OpenExcelSheet()
InitExcel()
FillExcelSheet()
SetPage()
End Sub
End Class
上面整个代码形式如下：
Imports System
Imports System.Windows.Forms
Imports Excel.ApplicationClass
Imports Excel.XlLineStyle
Imports Excel.XlPattern
Imports Excel.XlBorderWeight
Imports Excel.Constants
Imports Excel.XlBordersIndex
Namespace Reopot
Public Class CReport
…
End Class
Public Class CPublicExcel
…
End Class
Friend Class CExcelReport
Inherits CPublicExcel
…
End Class
End Namespace
|
