VB与Excel2000实现复杂报表打印(转载)

 

VB与Excel2000实现复杂报表打印

 

    数据库管理系统的开发人员经常被编制复杂的报表所困扰，VB的水晶报表可以设计简单的报表，但是设计出的报表缺乏灵活性。我利用VB操作EXCEL2000来生成复杂的报表。

    用VB创建外部EXCEL对象

    Microsoft Office应用程序提供了一个顶层Application 对象。下面语句显示了对Microsoft Excel的Application 对象的引用，用这些变量来访问在EXCEL应用程序中的从属对象、以及这些对象的属性和方法。：

Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Open(strDestination)
Set xlSheet = xlBook.Worksheets(1)

       用EXCEL 2000设计报表的模版文件

    EXCEL 2000是一个非常优秀的创建报表的工具。它提供的单元格任意合并、拆分功能基本上能够满足设计复杂报表的要求。它对任意一个单元格的格式随意控制，因此它为设计复杂报表提供了强大的支持。

    根据用户提供的报表，我们可以很快在EXCEL里生成模版文件。模版文件只是为了满足用户多方面的需求而设计的。并且随着时间和实际情况的变化，表格格式有可能需要改变，我们设计一个模版文件可以“以不变应万变”了。在程序里我们不要对模版文件进行操作，我们只需要对模版文件的一个拷贝进行操作就行。程序代码如下：

Dim strSource, strDestination As String
strSource = App.Path & "//Excels//dangan.xls"　
strDestination = App.Path & "//Excels//Temp.xls"　
FileCopy strSource, strDestination
Set mobjExcel = New Excel.Application
Set mobjExcel = CreateObject("Excel.Application")
mobjExcel.Visible = False
Set mobjworkbook = mobjExcel.Workbooks.Open(strDestination)
Set xlsheet = mobjworkbook.Worksheets(1)
If Not opendatasource() Then
　MsgBox "不能打开数据源!", , "提示"
　Unload Me
　Exit Sub
End If
Private Function opendatasource()
　ssql="select shgt_dah,shgt_yth,shgt_ajtm,shgt_chtrq,
　shgt_shjdw,shgt_wzysh,shgt_tzzhsh,shgt_gdrq,shgt_bz from shgtajb"
　OpenResultset ssql, mrdors
　opendatasource = True
　Exit Function
End Function

        生成工作表内容

    有了上述两步工作的铺垫，我们只要根据模板的格式给各单元格赋值如：

   

Do while Not mrdors.Eof i=4 For j=0 to mrdors.rdocolumns.count-2 MobjExcel.Activesheet.cells（i，j+1）。value=mrdors.rdocolumns（j）。Value Next Mrdors.movenext Loop

    打印报表

    生成了工作表后，就可以对EXCEL发出打印指令了。在执行打印操作之前应该对EXCEL临时文件执行一次保存操作，以免在退出应用程序后EXCEL还提示用户是否保存已修改的文件。如下语句：

   

xlBook.Save xlSheet.PrintOut xlApp.Quit

With xlsheet.PageSetup
        .Orientation = xlLandscape     '横向
        
        .LeftMargin = Application.InchesToPoints(0.25)
        .RightMargin = Application.InchesToPoints(0.25)
        .TopMargin = Application.InchesToPoints(0.4)
        .BottomMargin = Application.InchesToPoints(0.4)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
End With 

－－－－－－－－－－－－－－－－－

以上是对EXCEL的页面设置，但是在VB运行里不通过。请问要如何设置页边距这些值呢。

我想装左右页边距都设成0.25。

直接写 .LeftMargin = 0.25  也是错误的。

Private   Sub   Command2_Click()  
          Dim   xlapp   As   New   Excel.Application  
          Dim   xlbook     As   Excel.Workbook  
          Dim   xlsheet   As   Excel.Worksheet  
           
          xlapp.Caption   =   "test"  
          Set   xlbook   =   xlapp.Workbooks.Add  
          Set   xlsheet   =   xlbook.Worksheets(1)  
           
          With   xlapp.ActiveSheet.PageSetup  
                  .LeftHeader   =   ""  
                  .CenterHeader   =   ""  
                  .RightHeader   =   ""  
                  .LeftFooter   =   ""  
                  .CenterFooter   =   ""  
                  .RightFooter   =   ""  
                  .LeftMargin   =   Application.InchesToPoints(0.354330708661417)     '左边距  
                  .RightMargin   =   Application.InchesToPoints(0.354330708661417)   '右边距  
                  .TopMargin   =   Application.InchesToPoints(0.590551181102362)       '上边距  
                  .BottomMargin   =   Application.InchesToPoints(0.590551181102362)   '下边距  
                  .HeaderMargin   =   Application.InchesToPoints(0.118110236220472)   '页眉  
                  .FooterMargin   =   Application.InchesToPoints(0.118110236220472)   '   页脚  
                  .PrintHeadings   =   False  
                  .PrintGridlines   =   False  
                  .PrintComments   =   xlPrintNoComments  
                  .PrintQuality   =   600  
                  .CenterHorizontally   =   True  
                  .CenterVertically   =   True  
                  .Orientation   =   xlPortrait  
                  .Draft   =   False  
                  .PaperSize   =   xlPaperLetter  
                  .FirstPageNumber   =   xlAutomatic  
                  .Order   =   xlDownThenOver  
                  .BlackAndWhite   =   False  
                  .Zoom   =   100  
                  .PrintErrors   =   xlPrintErrorsDisplayed  
          End   With  
          xlapp.Visible   =   True  
  End   Sub