listview导出EXCEL？ - VB6论坛

得分:0

'*****************************************************打印报表*********************************************
Public Sub PrintReort()
On Error Resume Next
Dim i As Long, j As Long
Dim newFrm As FrmWait

If mvarmXPLvw.XPColumnHeaders.Count = 0 Then Exit Sub
If mvarmXPLvw.XPListItems.Count = 0 Then Exit Sub

'---------------------------------------------------------------
Set newFrm = New FrmWait
newFrm.Show
newFrm.FrmCaption = "打印 " & mvarFrmObject.Caption
Call newFrm.SetLblDescCaption("正在创建打印机的环境......")
Call newFrm.SetPsBarMode(1)
'---------------------------------------------------------------

If mExcel Is Nothing Then
'Set mExcel = CreateObject("Excel.Application")
Call CreateExcelObject 'Excel 创建对象
End If

If mExcel.Visible = True Then
mExcel.Visible = False
End If

mExcel.Caption = mvarFrmObject.Caption

Set mWorkBook = mExcel.Application.Workbooks.Add '新建工作区
Set mWorksheet = mWorkBook.Worksheets(1)
mWorksheet.Name = mvarFrmObject.Caption

'---------------------------------------------------------------
Call newFrm.SetLblDescCaption("正在导入要打印的数据，请等待......")
Call newFrm.SetPsBarMode(0)
Call newFrm.SetPsBarMax(mvarmXPLvw.XPColumnHeaders.Count + mvarmXPLvw.XPListItems.Count * mvarmXPLvw.XPColumnHeaders.Count + 5)
'---------------------------------------------------------------

For i = 1 To mvarmXPLvw.XPColumnHeaders.Count
mWorksheet.Cells(1, i) = mvarmXPLvw.XPColumnHeaders(i).Text
'---------------------------------------------------------------
Call newFrm.SetPsbarValue
'---------------------------------------------------------------
Next
For i = 1 To mvarmXPLvw.XPListItems.Count
For j = 1 To mvarmXPLvw.XPColumnHeaders.Count
mWorksheet.Cells(i + 1, j) = mvarmXPLvw.XPListItems(i).ListSubItems(j).Text
'---------------------------------------------------------------
Call newFrm.SetPsbarValue
'---------------------------------------------------------------
Next
Next

'---------------------------------------------------------------
Call newFrm.SetLblDescCaption("正在整理要打印的数据，请等待......")
Call newFrm.SetPsbarValue
'---------------------------------------------------------------

Call SettingExcelParameter(mExcel, mWorksheet, mWorkBook, mvarmXPLvw.XPColumnHeaders.Count, mvarmXPLvw.XPListItems.Count + 1)

mExcel.DisplayAlerts = False '设置不显示警告消息

mExcel.Visible = True

'---------------------------------------------------------------
Call newFrm.SetPsbarValue(1)
newFrm.Hide
'---------------------------------------------------------------

mWorksheet.PrintPreview

'---------------------------------------------------------------
newFrm.Show
Call newFrm.SetLblDescCaption("打印完毕正在关闭打印机环境，请等待......")
Call newFrm.SetPsbarValue(1)
'---------------------------------------------------------------

mExcel.Visible = False

Set mWorksheet = Nothing
Call mWorkBook.Close
Set mWorkBook = Nothing
mExcel.Workbooks.Close

'---------------------------------------------------------------
Call newFrm.SetPsbarValue(1)
Call WaitBehindDelay(500)

Unload newFrm
Set newFrm = Nothing
'---------------------------------------------------------------
End Sub
'**********************************************************************************************************