VB中使用excel的打印功能,加边框后只能打印一次,不加一切正常,请高手指点原因!~
代码目的是把一个flexgrid的内容导入到excel中,然后打印。
使用excel的打印功能,加边框后只能打印一次,不加一切正常,请高手指点原因!~
具体代码如下:
Private Sub cmdLogRecordPrint_Click()
On Error GoTo err1
Dim i As Long
Dim j As Long
Dim objExl As Excel.Application '声明对象变量
Me.MousePointer = 11 '改变鼠标样式
Set objExl = New Excel.Application '初始化对象变量
objExl.SheetsInNewWorkbook = 1 '将新建的工作薄数量设为1
objExl.Workbooks.Add '增加一个工作薄
objExl.Sheets(objExl.Sheets.Count).Name = "参数打印 " '修改工作薄名称
objExl.Sheets( "参数打印 ").Select '选中工作薄 <book1>
objExl.Cells(1, 1) = "参数表 "
objExl.Range(Cells(1, 1), Cells(1, 4)).Merge
objExl.Range(Cells(1, 1), Cells(1, 4)).VerticalAlignment = xlTop
objExl.Range(Cells(1, 1), Cells(1, 4)).HorizontalAlignment = xlCenter
objExl.Range(Cells(1, 1), Cells(1, 4)).CurrentRegion.Borders.LineStyle = xlContinuous
objExl.Cells(2, 1) = "序号 "
objExl.Cells(2, 2) = "用户名称 "
objExl.Cells(2, 3) = "记录信息 "
objExl.Cells(2, 4) = "记录时间 "
objExl.Range(Cells(2, 1), Cells(2, 4)).VerticalAlignment = xlTop
objExl.Range(Cells(2, 1), Cells(2, 4)).HorizontalAlignment = xlCenter
objExl.Range(Cells(2, 1), Cells(2, 4)).CurrentRegion.Borders.LineStyle = xlContinuous
For i = 3 To (usermessage.Rows + 3) - 1 - 1 '循环写入数据
For j = 1 To usermessage.Cols
objExl.Cells(i, j) = Trim(usermessage.TextMatrix(i - 2, j - 1))
Next j
objExl.Range(Cells(i, 1), Cells(i, 4)).VerticalAlignment = xlTop
objExl.Range(Cells(i, 1), Cells(i, 4)).HorizontalAlignment = xlCenter
objExl.Range(Cells(i, 1), Cells(i, 4)).CurrentRegion.Borders.LineStyle = xlContinuous
Next i
objExl.Rows( "1:1 ").Select '选中第一行
objExl.Selection.Font.Bold = True '设为粗体
objExl.Selection.Font.Size = 18 '设置字体大小
objExl.Cells.EntireColumn.AutoFit '自动调整列宽
objExl.Rows( "2:1 ").Select '选中第二行
objExl.Selection.Font.Bold = True '设为粗体编号
objExl.Selection.Font.Size = 16 '设置字体大小
objExl.Cells.EntireColumn.AutoFit '自动调整列宽
objExl.Range(Cells(1, 8), Cells(1, 11)).ColumnWidth = 10
'objExl.Range(Cells(1, 8), Cells(1, 11)).AutoFormat ,,,,,
objExl.ActiveSheet.PageSetup.PrintTitleRows = "$1:$2 " '设置打印固定行
'objExl.ActiveSheet.PageSetup.PrintTitleColumns = "记录 " '打印标题
objExl.ActiveSheet.PageSetup.RightFooter = "打印时间: " & _
Format(Now, "yyyy年mm月dd日 hh:MM:ss ")
'objExl.ActiveWindow.View = xlPageBreakPreview '设置显示方式
objExl.ActiveWindow.Zoom = 100 '设置显示大小
'objExl.ActiveSheet.PageSetup.Orientation = xlLandscape '设置打印方向(横向)
objExl.Visible = True
objExl.SheetsInNewWorkbook = 3 '将默认新工作薄数量改回3个
objExl.ActiveSheet.PrintPreview
objExl.DisplayAlerts = False '不显示提示保存对话框
objExl.Workbooks.Close
objExl.Quit '关闭EXCEL
Set objExl = Nothing '清除对象
Me.MousePointer = 0 '修改鼠标
Exit Sub
err1:
objExl.SheetsInNewWorkbook = 3
objExl.DisplayAlerts = False '关闭时不提示保存
objExl.Quit '关闭EXCEL
Set objExl = Nothing
Me.MousePointer = 0
End Sub
正常执行一次后,再执行到objExl.Range(Cells(1, 1), Cells(1, 4)).Merge就开始出现错误,怀疑是excel.exe驻留内存导致,请高手指点解决方法,拜谢
[解决办法]
objExl.Range(Cells(1, 1), Cells(1, 4)).Merge
--------你试试把所有含有objexl.range(cells(),cells())
改成 objexl.range(objexl.cells(),objexl.cells())