modwrite.bas

推荐这个有VB开发的小型超市销售管理系统

Attribute VB_Name = "modWrite"
Option Explicit
Public xlApp As Excel.Application '定义EXCEL类
Public xlBook As Excel.Workbook     '定义工件簿类
Public xlSheet As Excel.Worksheet '定义工作表类

'打印MS控件函数,iRowStart:从地极行开始打印
Public Sub writeMSFlexGrid(MS As MSFlexGrid, strName As String)
Dim iRow, iCol, iRows, iCols As Integer
Dim i As Integer
iRow = 0
iCol = 0
iRows = 0
iCols = 0

On Error Resume Next
    Set xlApp = CreateObject("Excel.Application") '创建EXCEL对象

    Set xlBook = xlApp.Workbooks.Add     '创建EXCEL工件簿文件
    Set xlSheet = xlBook.Worksheets(1)
    
    
    '打印准备
    iRows = MS.Rows
    iCols = MS.Cols
    
    '打印结果
    
    For iRow = 0 To iRows - 1
        For iCol = 0 To iCols - 1
            If IsNumeric(MS.TextMatrix(iRow, iCol)) Then
                xlSheet.Cells(iRow + 3, iCol + 1) = "'" & MS.TextMatrix(iRow, iCol)
            Else
                xlSheet.Cells(iRow + 3, iCol + 1) = MS.TextMatrix(iRow, iCol)
            End If
        Next iCol
    Next iRow
    '设置表格线
    xlSheet.Cells(1, 1) = strName
    xlSheet.Cells(2, 1) = "移交日期：" & Str(Year(Now)) & "年" & Str(Month(Now)) & "月" & Str(Day(Now)) & "日"
    xlSheet.Range(xlSheet.Cells(3, 1), xlSheet.Cells(iRows + 2, iCols)).Borders.LineStyle = xlContinuous
    '设置表格字体，大小
    xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(1, 9)).Font.Size = 20
    xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(3, 9)).Font.Bold = True
    xlSheet.Range(xlSheet.Cells(2, 1), xlSheet.Cells(iRows + 3, 9)).Font.Size = 11
    xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(iRows + 5, 9)).Font.Name = "宋体"
    '设置居中
    xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(iRows + 1, 9)).HorizontalAlignment = xlCenter
    xlSheet.Range(xlSheet.Cells(3, 1), xlSheet.Cells(3, 9)).HorizontalAlignment = xlLeft
    xlSheet.Range(xlSheet.Cells(4, 4), xlSheet.Cells(iRows + 1, 4)).HorizontalAlignment = xlLeft
    xlSheet.Range(xlSheet.Cells(4, 9), xlSheet.Cells(iRows + 1, 9)).HorizontalAlignment = xlLeft
    '合并单元格
    xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(1, 9)).MergeCells = True
    xlSheet.Range(xlSheet.Cells(2, 1), xlSheet.Cells(2, 9)).MergeCells = True
    
    xlSheet.Cells(iRows + 3, 1) = "提交人：王真"
    '设置列宽,行高
    xlSheet.Rows.AutoFit
    xlSheet.Columns.AutoFit
    
    '设置页面
    With xlSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    xlSheet.PageSetup.PrintArea = ""
    With xlSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = "第&""Times New Roman,常规"" &P &""宋体,常规""页"
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.78740157480315)
        .BottomMargin = Application.InchesToPoints(0.78740157480315)
        .HeaderMargin = Application.InchesToPoints(0.393700787401575)
        .FooterMargin = Application.InchesToPoints(0.393700787401575)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 180
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
    End With
    '显示单元格
    xlApp.Visible = True
    Set xlApp = Nothing
End Sub
Public Sub writeMS(strSql As String, MS As MSFlexGrid)
'动态向网格中添加数据
Dim iC, iRow, iCol, i As Integer
Dim RS As New ADODB.Recordset
Dim iRows, iCols As Integer
iC = 0
Set RS = dbSelect(strSql)
iCols = RS.Fields.Count
MS.Cols = iCols
MS.Rows = 1
MS.Rows = 2
While Not RS.EOF
    iC = iC + 1
    For i = 0 To iCols - 1
        MS.TextMatrix(iC, i) = RS.Fields(i)
    Next i
    MS.Rows = MS.Rows + 1
    RS.MoveNext
Wend
For i = 0 To iCols - 1
MS.TextMatrix(0, i) = RS.Fields(i).Name
Next i
MS.TextMatrix(MS.Rows - 1, 0) = "合计：" & iC
Set RS = Nothing
End Sub