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 SystemImports System.Windows.FormsImports Excel.ApplicationClassImports Excel.XlLineStyleImports Excel.XlPatternImports Excel.XlBorderWeightImports Excel.ConstantsImports Excel.XlBordersIndexNamespace Reopot Public Class CReport …End Class Public Class CPublicExcel…End ClassFriend Class CExcelReport Inherits CPublicExcel…End ClassEnd Namespace |
