如何導出列表視圖的所有數據與其標題在VB 6.0中的Excel表格

我將一個ListView控件的所有數據導出到Excel表格，在VB 6.0中。如何導出列表視圖的所有數據與其標題在VB 6.0中的Excel表格

我的代碼是下面：

Private Sub cmdExport_Click() 

'general 
Dim objExcel As New Excel.Application 

Dim objExcelSheet As Excel.Worksheet 
'----------------------------------- 

'check whether data is there 
If LstLog.ListItems.count > 0 Then 
objExcel.Workbooks.Add 
Set objExcelSheet = objExcel.Worksheets.Add 


For Col = 1 To LstLog.ColumnHeaders.count 
    objExcelSheet.Cells(1, Col).Value = LstLog.ColumnHeaders(Col) 
Next 

For Row = 2 To LstLog.ListItems.count 
    For Col = 1 To LstLog.ColumnHeaders.count 
    If Col = 1 Then 
      objExcelSheet.Cells(Row, Col).Value = LstLog.ListItems(Row).Text 
    Else 
      objExcelSheet.Cells(Row, Col).Value = LstLog.ListItems(Row).SubItems(Col - 1) 
    End If 
    Next 
Next 

objExcelSheet.Columns.AutoFit 
CommonDialog1.ShowOpen 
A = CommonDialog1.FileName 

objExcelSheet.SaveAs A & ".xls" 
MsgBox "Export Completed", vbInformation, Me.Caption 

objExcel.Workbooks.Open A & ".xls" 
objExcel.Visible = True 
'objExcel.Quit 
Else 
MsgBox "No data to export", vbInformation, Me.Caption 
End If 

End Sub

的問題是，從ListView中的第一行是通過從的ListView標題文本覆蓋。

來源

2013-04-12 user2273064

你嘗試過什麼（點com）？你是否也可以將此作爲一個問題來制定？ –

出於某種原因，您並未複製所有行。試試這個：

For Row = 2 To LstLog.ListItems.count + 1 
    For Col = 1 To LstLog.ColumnHeaders.count 
    If Col = 1 Then 
      objExcelSheet.Cells(Row, Col).Value = LstLog.ListItems(Row - 1).Text 
    Else 
      objExcelSheet.Cells(Row, Col).Value = LstLog.ListItems(Row - 1).SubItems(Col - 1) 
    End If 
    Next 
Next Row

來源

2013-04-12 09:15:36

我試過這個，但是用這個代碼所有列表項都來了，但列表視圖標題不會來。 – user2273064

@ user2273064讓我無需仔細閱讀整個問題！您需要寫入列表視圖索引+1。 –

試試這個，希望這將有助於ü

Function Export2XLS(sQuery As String) 
    Dim oExcel   As Object 
    Dim oExcelWrkBk  As Object 
    Dim oExcelWrSht  As Object 
    Dim bExcelOpened As Boolean 
    Dim db    As DAO.Database 
    Dim rs    As DAO.Recordset 
    Dim iCols   As Integer 
    Const xlCenter = -4108 

    'Start Excel 
    On Error Resume Next 
    Set oExcel = GetObject(, "Excel.Application") 'Bind to existing instance of Excel 

    If Err.Number <> 0 Then 'Could not get instance of Excel, so create a new one 
     Err.Clear 
     On Error GoTo Error_Handler 
     Set oExcel = CreateObject("excel.application") 
     bExcelOpened = False 
    Else 'Excel was already running 
     bExcelOpened = True 
    End If 
    On Error GoTo Error_Handler 
    oExcel.ScreenUpdating = False 
    oExcel.Visible = False 'Keep Excel hidden until we are done with our manipulation 
    Set oExcelWrkBk = oExcel.Workbooks.Add() 'Start a new workbook 
    Set oExcelWrSht = oExcelWrkBk.Sheets(1) 

    'Open our SQL Statement, Table, Query 
    Set db = CurrentDb 
    Set rs = db.OpenRecordset(sQuery, dbOpenSnapshot) 
    With rs 
     If .RecordCount <> 0 Then 
      'Build our Header 
      For iCols = 0 To rs.Fields.Count - 1 
       oExcelWrSht.Cells(1, iCols + 1).Value = rs.Fields(iCols).Name 
      Next 
      With oExcelWrSht.Range(oExcelWrSht.Cells(1, 1), _ 
            oExcelWrSht.Cells(1, rs.Fields.Count)) 
       .Font.Bold = True 
       .Font.ColorIndex = 2 
       .Interior.ColorIndex = 1 
       .HorizontalAlignment = xlCenter 
      End With 
      oExcelWrSht.Range(oExcelWrSht.Cells(1, 1), _ 
           oExcelWrSht.Cells(1, rs.Fields.Count)).Columns.AutoFit 'Resize our Columns based on the headings 
      'Copy the data from our query into Excel 
      oExcelWrSht.Range("A2").CopyFromRecordset rs 
      oExcelWrSht.Range("A1").Select 'Return to the top of the page 
     Else 
      MsgBox "There are no records returned by the specified queries/SQL statement.", vbCritical + vbOKOnly, "No data to generate an Excel spreadsheet with" 
      GoTo Error_Handler_Exit 
     End If 
    End With 

    ' oExcelWrkBk.Close True, sFileName 'Save and close the generated workbook 

    ' 'Close excel if is wasn't originally running 
    ' If bExcelOpened = False Then 
    '  oExcel.Quit 
    ' End If 

Error_Handler_Exit: 
    On Error Resume Next 
    oExcel.Visible = True 'Make excel visible to the user 
    rs.Close 
    Set rs = Nothing 
    Set db = Nothing 
    Set oExcelWrSht = Nothing 
    Set oExcelWrkBk = Nothing 
    oExcel.ScreenUpdating = True 
    Set oExcel = Nothing 
    Exit Function 

Error_Handler: 
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _ 
      "Error Number: " & Err.Number & vbCrLf & _ 
      "Error Source: Export2XLS" & vbCrLf & _ 
      "Error Description: " & Err.Description _ 
      , vbOKOnly + vbCritical, "An Error has Occured!" 
    Resume Error_Handler_Exit 
End Function

來源

2015-04-06 10:45:55

如何導出列表視圖的所有數據與其標題在VB 6.0中的Excel表格

回答

相關問題