我想把LISTVIEW中的資料匯出到EXCEL表格中，匯出一次沒什么問題，當匯出多次的時候就會提示：
方法‘~’作用于物件‘~’失敗
每匯出一次，任務管理器里就會有一個EXCEL.EXE行程
我的代碼如下，希望各位大大們幫忙看下
我的環境是VB6.0 OFFICE 2012
Public Sub ExportExl(ByVal sName As String, ByVal sFile As String)
On Error GoTo Error:
If ListView.ListItems.Count = 0 Then
MsgBox "表格中無資料，無法匯出", 16, "錯誤"
Exit Sub
Else
Dim objExl As Excel.Application '宣告物件變數
Dim xlBook As Excel.Workbook
Set objExl = New Excel.Application '初始化物件變數
If Dir(App.Path + "\Excel\" & sFile, vbDirectory) = "" Then
objExl.SheetsInNewWorkbook = 1 '將新建的作業薄數量設為1
objExl.Workbooks.Add '增加一個作業薄
objExl.Sheets(objExl.Sheets.Count).Name = sName '修改作業薄名稱
Else
Set xlBook = objExl.Workbooks.Open(App.Path + "\Excel\" & sFile) '打開Excel檔案
xlBook.Sheets.Add After:=objExl.Worksheets(Worksheets.Count) '插入新的Sheet
xlBook.ActiveSheet.Name = sName '重新命名新的Sheet
End If
objExl.Sheets(sName).Select '選中作業薄<book1>
objExl.Range("A2", "E2").Merge
objExl.Range("A2").Value = "人員月記錄明細"
objExl.Range("A3", "E3").Merge
objExl.Range("A3").Value = "姓名:" & sName
objExl.Range("A4").Value = "日期"
objExl.Range("B4").Value = "考情"
objExl.Range("C4").Value = "薪水"
objExl.Range("D4").Value = "借支"
objExl.Range("E4").Value = "報銷"
objExl.ActiveWorkbook.ActiveSheet.Range("A2").HorizontalAlignment = xlCenter '水平居中
objExl.ActiveWorkbook.ActiveSheet.Range("A2").Font.Bold = True '設為粗體
objExl.ActiveWorkbook.ActiveSheet.Range("A3").Font.Bold = True '設為粗體
objExl.ActiveWorkbook.ActiveSheet.Range("A4").HorizontalAlignment = xlCenter '水平居中
objExl.ActiveWorkbook.ActiveSheet.Range("A4").Font.Bold = True '設為粗體
objExl.ActiveWorkbook.ActiveSheet.Range("B4").HorizontalAlignment = xlCenter '水平居中
objExl.ActiveWorkbook.ActiveSheet.Range("B4").Font.Bold = True '設為粗體
objExl.ActiveWorkbook.ActiveSheet.Range("C4").HorizontalAlignment = xlCenter '水平居中
objExl.ActiveWorkbook.ActiveSheet.Range("C4").Font.Bold = True '設為粗體
objExl.ActiveWorkbook.ActiveSheet.Range("D4").HorizontalAlignment = xlCenter '水平居中
objExl.ActiveWorkbook.ActiveSheet.Range("D4").Font.Bold = True '設為粗體
objExl.ActiveWorkbook.ActiveSheet.Range("E4").HorizontalAlignment = xlCenter '水平居中
objExl.ActiveWorkbook.ActiveSheet.Range("E4").Font.Bold = True '設為粗體
Dim i As Integer
For i = 1 To ListView.ListItems.Count
objExl.Range("A" & 4 + i).NumberFormatLocal = "@"
objExl.Range("A" & 4 + i).Value = Format(ListView.ListItems.Item(i).SubItems(1), "yyyy-mm-dd")
objExl.Range("B" & 4 + i).Value = ListView.ListItems.Item(i).SubItems(3)
objExl.Range("C" & 4 + i).Value = ListView.ListItems.Item(i).SubItems(4)
objExl.Range("D" & 4 + i).Value = ListView.ListItems.Item(i).SubItems(5)
objExl.Range("E" & 4 + i).Value = ListView.ListItems.Item(i).SubItems(6)
Next i
'合并
objExl.Range("A36", "E37").Merge
objExl.Range("A36").Value = ReadText(StatusBar.Panels(1).Text, sName)
objExl.ActiveWorkbook.ActiveSheet.Range("A36").Font.Bold = True '設為粗體
'單元格自動換行
objExl.ActiveWorkbook.ActiveSheet.Range("A36").WrapText = True
objExl.ActiveWorkbook.ActiveSheet.Range("A36").Columns("A:A").Select
objExl.ActiveWorkbook.ActiveSheet.Range("A36").ColumnWidth = 7.1
objExl.Range("A38", "E38").Merge
objExl.Range("A39", "E39").Merge
objExl.Range("A40", "E40").Merge
objExl.Range("A38").Value = "考勤無誤員工簽字： 年 月 日"
objExl.Range("A39").Value = "工資領取員工簽字： 年 月 日"
objExl.Range("A40").Value = "工資發放人員簽字： 年 月 日"
objExl.ActiveWorkbook.ActiveSheet.rows(38).RowHeight = 27
objExl.ActiveWorkbook.ActiveSheet.rows(39).RowHeight = 27
objExl.ActiveWorkbook.ActiveSheet.rows(40).RowHeight = 27
'設定邊框
objExl.ActiveWorkbook.ActiveSheet.Range("A2:E40").Borders.LineStyle = 1
objExl.ActiveWorkbook.ActiveSheet.Range("A2:E40").Borders.Weight = 2
objExl.ActiveWorkbook.ActiveSheet.Range("A2:E40").Borders.ColorIndex = 1
objExl.Columns("A:E").AutoFit '自動調整行寬
objExl.ActiveWorkbook.SaveAs App.Path + "\Excel\" & sFile
objExl.Workbooks.Close
objExl.Quit
'Set Sht = Nothing
Set xlBook = Nothing
Set objExl = Nothing
End If
MsgBox "當前表格資料已經匯出至Excel中", 64, "提示"
Exit Sub
Error:
If err.Description <> vbNullString Then
MsgBox err.Description
err.Clear
End If
Set xlBook = Nothing
Set objExl = Nothing
End Sub
uj5u.com熱心網友回復：
有沒有人大俠去那里了uj5u.com熱心網友回復：
Set objExl = New Excel.Application '初始化物件變數改為：
Set objExl = getobject("Excel.Application")
if objexl is nothing then Set objExl = New Excel.Application
試試
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/125029.html
上一篇：VB中如何洗掉子檔案夾的檔案夾?
下一篇：大家給點建議呀？