巨恶的office 2007
WPS还是不错的,我用2007做的报表:
Private Sub Command1_Click() ';创建报表,得找个人看着,随时修改可能出现的表格跨页
Command1.Enabled = False
Form1.WindowState = 1 ';把窗体最小化,否则会挡眼睛滴
Dim WPSDocument As WPS.Document
';首先在数据记录表里查询有多少个记录
Dim EtWB As ET.workbook
';启动ET
Set ETApp = CreateObject("ET.Application")
ETApp.Visible = False ';藏起来,不让你看
TempFile = App.Path + "\Files\准备报告.et"
Set EtWB = ETApp.Workbooks.Open(TempFile)
For i = 1 To 65536
If EtWB.ActiveSheet.Cells(i, 150).Value = "" Then
LastRow = i ';返回第一个空行的行序数,金山真是小乖乖,怎么从1开始数呢
Exit For ';找到了最后一个空行
End If
Next i
'; 启动WPS
Set WPSApp = CreateObject("WPS.Application")
'; 使WPS可见
WPSApp.Visible = True
';打开模板
TempFile = App.Path + "\Files\Template.wps"
Set WPSDocument = WPSApp.Documents.Open(TempFile, ReadOnly:=True)
WPSApp.Selection.WholeStory ';全选
WPSApp.Selection.Copy ';复制,这个过程中别的程序别占剪贴板
';打开报表文件
TempFile = App.Path + "\Files\报表.wps"
Set WPSDocument = WPSApp.Documents.Open(TempFile)
WPSApp.Selection.WholeStory ';全选
WPSApp.Selection.Delete
';开始创建报表
ReportPage = LastRow - 1 ';共这么多页报表
If ReportPage = 0 Then ';什么数据都没有,就直接退出,白忙活了
';退出WPS
On Error Resume Next
WPSApp.Quit False
'; 释放对象
Set WPSApp = Nothing
';退出ET
ETApp.Quit
';释放对象
Set ETApp = Nothing
Command1.Enabled = True
Exit Sub
End If
For i = 1 To ReportPage
WPSApp.Selection.EndKey Unit:=wpsStory ';使光标移动到文件的尾部
WPSApp.Selection.Paste
WPSApp.Selection.EndKey Unit:=wpsStory ';再次到尾部
WPSApp.Selection.MoveUp Unit:=wpsLine, Count:=7 ';回到第一行
';开始填充数据
WPSApp.Selection.TypeText Text:=EtWB.ActiveSheet.Cells(i, 1).Value ';学科
WPSApp.Selection.MoveRight Unit:=wpsCharacter, Count:=2
WPSApp.Selection.TypeText Text:=EtWB.ActiveSheet.Cells(i, 2).Value ';年级
WPSApp.Selection.MoveRight Unit:=wpsCharacter, Count:=2
WPSApp.Selection.TypeText Text:=EtWB.ActiveSheet.Cells(i, 3).Value ';学年
WPSApp.Selection.MoveRight Unit:=wpsCharacter, Count:=3
WPSApp.Selection.TypeText Text:=EtWB.ActiveSheet.Cells(i, 4).Value ';上或下
';写完表头,手动定位光标
Form2.Show 1 ';不设置就不走
WPSApp.Selection.TypeText Text:=EtWB.ActiveSheet.Cells(i, 5).Value ';周次
WPSApp.Selection.MoveRight Unit:=wpsCharacter, Count:=1
WPSApp.Selection.TypeText Text:=EtWB.ActiveSheet.Cells(i, 6).Value ';日期
WPSApp.Selection.MoveRight Unit:=wpsCharacter, Count:=1
WPSApp.Selection.TypeText Text:=EtWB.ActiveSheet.Cells(i, 7).Value ';实验名称
WPSApp.Selection.MoveRight Unit:=wpsCharacter, Count:=1
WPSApp.Selection.TypeText Text:=EtWB.ActiveSheet.Cells(i, 8).Value ';类型
WPSApp.Selection.MoveRight Unit:=wpsCharacter, Count:=1
WPSApp.Selection.TypeText Text:=EtWB.ActiveSheet.Cells(i, 9).Value ';所需
WPSApp.Selection.MoveRight Unit:=wpsCharacter, Count:=1
WPSApp.Selection.TypeText Text:=EtWB.ActiveSheet.Cells(i, 10).Value ';缺
WPSApp.Selection.MoveRight Unit:=wpsCharacter, Count:=1
WPSApp.Selection.TypeText Text:=EtWB.ActiveSheet.Cells(i, 11).Value ';办法
WPSApp.Selection.MoveRight Unit:=wpsCharacter, Count:=1
WPSApp.Selection.TypeText Text:=EtWB.ActiveSheet.Cells(i, 12).Value ';意见
';数据填充完毕
Next i
';MsgBox LastRow
PRntFile = App.Path + "\打印\实验准备报告.wps"
WPSApp.ActiveDocument.SaveAs FileName:=PRntFile
';退出WPS
On Error Resume Next
WPSApp.Quit False
'; 释放对象
Set WPSApp = Nothing
';退出ET
ETApp.Quit
';释放对象
Set ETApp = Nothing
Command1.Enabled = True
MsgBox "可以打印的报表已保存在:" + Chr(13) + PRntFile ';嘿嘿
End Sub
启动速度快,安装文件小,刚好够用就行了.