modexcelprint.bas

VB中应用程序中对Excel表格进行打印的程序很不错哦

Attribute VB_Name = "ModExcelPrint"
Option Explicit
'Dim temp_excel As excel.Application
Dim Xlapp As New Excel.Application
Dim Xlbook As New Excel.Workbook
Dim Xlsheet As New Excel.Worksheet

Public Sub Print_Excel_2(Msflex As MSFlexGrid, Str_CenterHeader As String, Str_LeftHeader As String)
    Dim SomeArray() As Variant
    Dim Row         As Long
    Dim Col         As Long
    Dim Recs        As Long
    Dim i           As Long
    Dim temp        As Variant
    FileCopy App.Path & "\Excel_Print_Rk0.xls", App.Path & "\Excel_Print_Rk1.xls"
    Set Xlbook = Xlapp.Workbooks.Open(App.Path & "\Excel_Print_Rk1.xls")  '时间一般多
    Set Xlsheet = Xlbook.Worksheets("sheet1")
    Xlsheet.Activate
    If Len(Dir(Xlapp.DefaultFilePath & "\resume.xlw")) > 0 Then
        Kill Xlapp.DefaultFilePath & "\resume.xlw"
    End If
    ReDim SomeArray(Msflex.Rows, Msflex.Cols)
    '拷贝到数组
    Recs = Msflex.Rows
    For Row = 0 To Recs - 1
        For Col = 0 To Msflex.Cols - 1
            SomeArray(Row, Col) = Msflex.TextMatrix(Row, Col)
            If IsNull(SomeArray(Row, Col)) Then _
            SomeArray(Row, Col) = ""
        Next
    Next
    '表单賦值
    Xlsheet.Range(Xlsheet.Cells(1, 1), Xlsheet.Cells(Recs, Msflex.Cols)).Value = SomeArray
    '表单的数值靠左放置
    'Xlsheet.Range(Xlsheet.Cells(1, 1), Xlsheet.Cells(Recs, Msflex.Cols)).HorizontalAlignment = xlLeft
    '表单数据范围选中
    Xlsheet.Range(Xlsheet.Cells(1, 1), Xlsheet.Cells(Recs, Msflex.Cols)).Borders.LineStyle = xlContinuous
    
    Xlsheet.Range(Xlsheet.Cells(1, 1), Xlsheet.Cells(Recs, Msflex.Cols)).Select
    
    For i = 1 To Msflex.Cols
    temp = Msflex.ColWidth(i - 1)
    Xlsheet.Columns(i).ColumnWidth = temp / 120
    Next i
    'Xlsheet.PageSetup.CenterFooter = Chr(13) + Chr(10) + "第" + "&p" + "页"
    Xlsheet.PageSetup.CenterHeader = Xlsheet.PageSetup.CenterHeader & "丰田汽配公司---" & Str_CenterHeader
    'Xlsheet.PageSetup.PaperSize = xlPaperUser
    
    Xlapp.SaveWorkspace
    Xlapp.Visible = True
    Xlsheet.PrintPreview
    If Len(Dir(Xlapp.DefaultFilePath & "\resume.xlw")) > 0 Then
        Kill Xlapp.DefaultFilePath & "\resume.xlw"
    End If
    Xlapp.SaveWorkspace
    Xlapp.Quit
    Set Xlapp = Nothing
    Set Xlbook = Nothing
    Set Xlsheet = Nothing
    Kill App.Path & "\Excel_Print_Rk1.xls"
End Sub