引用Excel 试试Dim xlsApp As Excel.Application Dim xlsBook As Excel.Workbook Dim xlssheet As Excel.Worksheet Set xlsApp = New Excel.Application Set xlsApp = CreateObject("Excel.Application") xlsApp.Visible = False Set xlsBook = xlsApp.Workbooks.Open(app.path & "\filename.xls") Set xlssheet = xlsBook.Worksheets(1) for i=1 to mshflexgrid.rows for j=1 to mshflexgrid.cols With xlssheet mshflexgrid.row=i mshflexgrid.col=j .Cells(i, j) = mshflexgrid.text End With next j next i xlsBook.Save xlssheet.PrintPreview xlsApp.Quit Set rsExesList = Nothing Set cnExesList = Nothing Set xlsApp = Nothing Set xlsBook = Nothing Set xlssheet = Nothing
用printer对象打印表格 用msflexgrid控件显示的表格,要将它打印出来,最简单的方法是用printform方法,然而这只适合于数据正好能被屏幕显示的,即数据量少的,而且这种打印效果很差。而用printer对象进行打印编程,虽然麻烦点,但效果却是相当不错的,你可以自定义打印格式,打印页数,表格的粗细,字体大小等。实际上用printer对象进行打印编程是比较简单的。下面我就用一实例来说明:打印的内容是一张数据表,这里就只有两列数据,包括标题,副标题。(用A4纸打印)假设数据处在C_DataArray(),和R_DataArray()中C_Name与R_Name分别为两数据项的字段名Public Sub Printtable() '初始化Dim printer1 as PrinterDim pageheader Dim pagefooter Dim pageleft Dim pageright Dim usewidth Dim useheight Dim i, j, k As Integer Dim word As String Dim startx Dim starty Dim startyline ‘ 用来纪录打印竖线的起点Dim endyline ’ 用来纪录打印竖线的末点设置页面参数pageheader = 25 pagefooter = 25 pageleft = 20 pageright = 20 With printer1 .PaperSize = 9 .ScaleMode = 6 .FontBold = True .ScaleLeft = -20 .ScaleTop = -25 .ScaleWidth = 210 '设置为A4纸 .ScaleHeight = 297 usewidth = .ScaleWidth - 40 useheight = .ScaleHeight - 50 .CurrentX = 0 .CurrentY = 0 .DrawWidth = 5 End With '打印标题 With printer1 .FontSize = 20 .CurrentX = (usewidth - .TextWidth(DataTitle)) / 2 .CurrentY = pageheader + .ScaleTop End With printer1.Print DataTitle
'打印副标题 printer1.FontSize = 15 word = DataTitle2 printer1.CurrentX = usewidth - printer1.TextWidth(word) printer1.Print word
首先你得在工程-引用…-中引用microsoft excel 9.0 object library Dim j As Integer Dim xlapp As Excel.Application Dim xlbook As Excel.Workbook Dim xlsheet As Excel.Worksheet Set xlapp = CreateObject("excel.application") xlapp.Visible = True Set xlbook = xlapp.Workbooks.Add '在excel中添加一了个新的工作表 Set xlsheet = xlbook.Worksheets(1) '把excel中的sheet1作为当前工作表 Dim conn As ADODB.Connection Dim rs As ADODB.Recordset Dim provider As String Dim dbpath As String Set conn = New ADODB.Connection provider = "provider=microsoft.jet.oledb.4.0;" dbpath = "data source=你的数据库所在的路径及名" '(如果你的数据库与工程在同一个文件夹下,则用 dbpath="data source=" & app.path & "\*.mdb") conn.open provider & dbpath conn.CursorLocation = adUseClient Set rs = New ADODB.Recordset rs.open "xjb", conn, Cursor, 2 For j = 0 To rs.Fields.Count - 1 xlsheet.Cells(1, j + 1) = rs.Fields(j).Name Next j xlsheet.Range("A2").CopyFromRecordset rs
更正: 首先你得在工程-引用…-中引用microsoft excel 9.0 object library Dim j As Integer Dim xlapp As Excel.Application Dim xlbook As Excel.Workbook Dim xlsheet As Excel.Worksheet Set xlapp = CreateObject("excel.application") xlapp.Visible = True Set xlbook = xlapp.Workbooks.Add '在excel中添加一了个新的工作表 Set xlsheet = xlbook.Worksheets(1) '把excel中的sheet1作为当前工作表 Dim conn As ADODB.Connection Dim rs As ADODB.Recordset Dim provider As String Dim dbpath As String Set conn = New ADODB.Connection provider = "provider=microsoft.jet.oledb.4.0;" dbpath = "data source=你的数据库所在的路径及名" '(如果你的数据库与工程在同一个文件夹下,则用 dbpath="data source=" & app.path & "\*.mdb") conn.open provider & dbpath conn.CursorLocation = adUseClient Set rs = New ADODB.Recordset rs.open "表名"或sql语句, conn, Cursor, 2 For j = 0 To rs.Fields.Count - 1 xlsheet.Cells(1, j + 1) = rs.Fields(j).Name Next j xlsheet.Range("A2").CopyFromRecordset rs
Dim xlsBook As Excel.Workbook
Dim xlssheet As Excel.Worksheet
Set xlsApp = New Excel.Application
Set xlsApp = CreateObject("Excel.Application")
xlsApp.Visible = False
Set xlsBook = xlsApp.Workbooks.Open(app.path & "\filename.xls")
Set xlssheet = xlsBook.Worksheets(1)
for i=1 to mshflexgrid.rows
for j=1 to mshflexgrid.cols
With xlssheet
mshflexgrid.row=i
mshflexgrid.col=j
.Cells(i, j) = mshflexgrid.text
End With
next j
next i
xlsBook.Save
xlssheet.PrintPreview
xlsApp.Quit
Set rsExesList = Nothing
Set cnExesList = Nothing
Set xlsApp = Nothing
Set xlsBook = Nothing
Set xlssheet = Nothing
'初始化Dim printer1 as PrinterDim pageheader
Dim pagefooter
Dim pageleft
Dim pageright
Dim usewidth
Dim useheight
Dim i, j, k As Integer
Dim word As String
Dim startx
Dim starty
Dim startyline ‘ 用来纪录打印竖线的起点Dim endyline ’ 用来纪录打印竖线的末点设置页面参数pageheader = 25
pagefooter = 25
pageleft = 20
pageright = 20
With printer1
.PaperSize = 9
.ScaleMode = 6
.FontBold = True
.ScaleLeft = -20
.ScaleTop = -25
.ScaleWidth = 210 '设置为A4纸
.ScaleHeight = 297
usewidth = .ScaleWidth - 40
useheight = .ScaleHeight - 50
.CurrentX = 0
.CurrentY = 0
.DrawWidth = 5
End With
'打印标题
With printer1
.FontSize = 20
.CurrentX = (usewidth - .TextWidth(DataTitle)) / 2
.CurrentY = pageheader + .ScaleTop
End With
printer1.Print DataTitle
'打印副标题
printer1.FontSize = 15
word = DataTitle2
printer1.CurrentX = usewidth - printer1.TextWidth(word)
printer1.Print word
'打印第一条线 Line方法不能用在with ....end with里printer1.CurrentX = pageleft + printer1.ScaleLeft
startyline = printer1.CurrentY
'线宽printer1.Line -((printer1.ScaleLeft + printer1.ScaleWidth - pageleft), printer1.CurrentY)
printer1.FontSize = 10
'printer1.Print vbLf
printer1.CurrentY = printer1.CurrentY + 1
'打印第一个字段名
starty = printer1.CurrentY
printer1.CurrentX = ((printer1.ScaleWidth - 40) / 2 - printer1.TextWidth(C_Name)) / 2printer1.Print C_Name
'打印第二个字段名
printer1.CurrentX = usewidth / 2 + ((usewidth / 2 - printer1.TextWidth(R_Name)) / 2)
printer1.CurrentY = starty
printer1.Print R_Name
printer1.CurrentY = printer1.CurrentY + 1
'打印数据和横线,rownum为数据行数For i = 1 To rownum
'判断是否该页已打满
If printer1.CurrentY >= useheight Then '打印横线
printer1.CurrentX = printer1.ScaleLeft + pageleft
printer1.Line -((printer1.ScaleLeft + printer1.ScaleWidth - pageleft), printer1.CurrentY)
printer1.CurrentY = printer1.CurrentY + 1
'打印三条竖线
endyline = printer1.CurrentY
printer1.Line (0, startyline)-(0, endyline)
printer1.Line (usewidth / 2, startyline)-(usewidth / 2, endyline)
printer1.Line (usewidth, startyline)-(usewidth, endyline)
'打印页号
With printer1
.CurrentX = (.ScaleWidth - .TextWidth(.Page)) / 2 - pageleft
.CurrentY = useheight + 3
End With
printer1.Print printer1.Page
printer1.NewPage
With printer1
.CurrentX = pageleft + .ScaleLeft
.CurrentY = pageheader + .ScaleTop
startyline = .CurrentY
End With
End If
'打印一行数据
printer1.CurrentX = ((printer1.ScaleWidth - 40) / 2 - printer1.TextWidth(C_DataArray(i))) / 2
starty = printer1.CurrentY
printer1.Print C_DataArray(i)
printer1.CurrentX = (printer1.ScaleWidth - 40) / 2 + ((printer1.ScaleWidth - 40) / 2 - printer1.TextWidth(R_DataArray(i) )) / 2
printer1.CurrentY = starty
printer1.Print R_DataArray(i)
printer1.CurrentY = printer1.CurrentY + 1
Next i
'打印最后一条横线
printer1.CurrentX = printer1.ScaleLeft + pageleft
printer1.Line -((printer1.ScaleLeft + printer1.ScaleWidth - pageleft), printer1.CurrentY)
endyline = printer1.CurrentY
'打印三条竖线
printer1.Line (0, startyline)-(0, endyline)
printer1.Line (usewidth / 2, startyline)-(usewidth / 2, endyline)
printer1.Line (usewidth, startyline)-(usewidth, endyline)
'打印页号
With printer1
.CurrentX = (.ScaleWidth - .TextWidth(.Page)) / 2 - pageleft
.CurrentY = useheight + 3
End With
printer1.Print printer1.Page
printer1.EndDoc
end sub
个人专栏:http://www.csdn.net/develop/author/netauthor/lihonggen0/
------------------------------------------------------------------
.PaperSize = 9提示出错error"91" object variable or with block variable not set
因为它涉及到不能显示出来的哪部份记录
还得另行想办法解决
你可以把数据记录从数据表中直接传送到excel中然后进行排版打印
如果你想通过这种方法进行的话,可以留言我这里有已通过测试的代码
Dim j As Integer
Dim xlapp As Excel.Application
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Set xlapp = CreateObject("excel.application")
xlapp.Visible = True
Set xlbook = xlapp.Workbooks.Add '在excel中添加一了个新的工作表 Set xlsheet = xlbook.Worksheets(1) '把excel中的sheet1作为当前工作表
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim provider As String
Dim dbpath As String
Set conn = New ADODB.Connection
provider = "provider=microsoft.jet.oledb.4.0;"
dbpath = "data source=你的数据库所在的路径及名" '(如果你的数据库与工程在同一个文件夹下,则用 dbpath="data source=" & app.path & "\*.mdb")
conn.open provider & dbpath
conn.CursorLocation = adUseClient
Set rs = New ADODB.Recordset
rs.open "xjb", conn, Cursor, 2
For j = 0 To rs.Fields.Count - 1
xlsheet.Cells(1, j + 1) = rs.Fields(j).Name
Next j
xlsheet.Range("A2").CopyFromRecordset rs
首先你得在工程-引用…-中引用microsoft excel 9.0 object library
Dim j As Integer
Dim xlapp As Excel.Application
Dim xlbook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Set xlapp = CreateObject("excel.application")
xlapp.Visible = True
Set xlbook = xlapp.Workbooks.Add '在excel中添加一了个新的工作表 Set xlsheet = xlbook.Worksheets(1) '把excel中的sheet1作为当前工作表
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim provider As String
Dim dbpath As String
Set conn = New ADODB.Connection
provider = "provider=microsoft.jet.oledb.4.0;"
dbpath = "data source=你的数据库所在的路径及名" '(如果你的数据库与工程在同一个文件夹下,则用 dbpath="data source=" & app.path & "\*.mdb")
conn.open provider & dbpath
conn.CursorLocation = adUseClient
Set rs = New ADODB.Recordset
rs.open "表名"或sql语句, conn, Cursor, 2
For j = 0 To rs.Fields.Count - 1
xlsheet.Cells(1, j + 1) = rs.Fields(j).Name
Next j
xlsheet.Range("A2").CopyFromRecordset rs