Member 8737191 Ответов: 2

как экспортировать элементы ListView в Excel лист с заголовком списка.

Я пытаюсь экспортировать данные listview в vb 6.0 в лист excel с заголовком listview.

Мой код таков:-
Private Sub cmdExport_Click()

'genaral
Dim objExcel As New Excel.Application

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

'check whether data is thre
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

Но когда я экспортирую данные на лист excel с этим кодом, первая строка элемента представления списка заменяется заголовком представления списка..

Пожалуйста помочь.

Maciej Los

Код выглядит нормально, попробуйте отладить программу и проверить, почему это происходит...

Aydin Homay

Пожалуйста, отслеживать Ваш для блокируют:

Для Строки = 2 В LstLog.Элементам списка.граф
Для Col = 1 - LstLog.ColumnHeaders.граф
Если Col = 1, То
objExcelSheet.Ячейки(Row, Col).Значение = LstLog.Элементам Списка(Строку).Текст
Еще
objExcelSheet.Ячейки(Row, Col).Значение = LstLog.ListItems(Строка).Подпункты(Col - 1)
Конец, Если
Следующий
Следующий
Я думаю, что у вас есть ошибка при инициализации second for.

с уважением.

2 Ответов

Рейтинг:
2

Member 10655931 

Public Sub export_me_to_excel(ByVal list As ListView)
    Try
        Dim objExcel As New Excel.Application
        Dim bkWorkBook As Workbook
        Dim shWorkSheet As Worksheet
        Dim chartRange As Excel.Range


        Dim i As Integer
        Dim j As Integer

        objExcel = New Excel.Application
        bkWorkBook = objExcel.Workbooks.Add
        shWorkSheet = CType(bkWorkBook.ActiveSheet, Worksheet)
        shWorkSheet.DisplayRightToLeft = True

        chartRange = shWorkSheet.Range("a1", "e2")
        chartRange.Merge()
        chartRange.FormulaR1C1 = xlval

        chartRange.HorizontalAlignment = 2
        chartRange.VerticalAlignment = 2

        For i = 0 To list.Columns.Count - 1
            shWorkSheet.Cells(5, i + 1) = list.Columns(i).Text
            shWorkSheet.Columns.AutoFit()
            shWorkSheet.Columns.HorizontalAlignment = Excel.Constants.xlCenter

            'shWorkSheet.Range(newcell).BorderAround2(Excel.XlLineStyle.xlContinuous, XlBorderWeight.xlMedium, XlColorIndex.xlColorIndexAutomatic, Excel.XlColorIndex.xlColorIndexAutomatic)
        Next
        For i = 0 To list.Items.Count - 1
            For j = 0 To list.Items(i).SubItems.Count - 1
                shWorkSheet.Cells(i + 6, j + 1) = list.Items(i).SubItems(j).Text
                shWorkSheet.Columns.AutoFit()
                shWorkSheet.Columns.HorizontalAlignment = Excel.Constants.xlCenter
                'shWorkSheet.Columns.BorderAround(Excel.XlLineStyle.xlContinuous, Excel.XlBorderWeight.xlMedium, Excel.XlColorIndex.xlColorIndexAutomatic, Excel.XlColorIndex.xlColorIndexAutomatic)

            Next
        Next

        objExcel.Visible = True
    Catch ex As Exception
        MsgBox(ex.Message)
    End Try
End Sub

Dave Kreskowiak

Совершенно необъяснимый фрагмент кода бесполезен в качестве ответа.

Рейтинг:
0

clwprogrammer

Заменять

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


с
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-1).Text
    Else
            objExcelSheet.Cells(Row, Col).Value = LstLog.ListItems(Row-1).SubItems(Col - 1)
    End If
    Next
Next



Заголовки не переопределяли первую запись данных. Код просто пропускал первую запись данных в listview.

если последний элемент не отображается в экспортированных данных, то измените его
For Row = 2 To LstLog.ListItems.count

к
For Row = 2 To LstLog.ListItems.count + 1

PrianCarlos BoqRad RemSer

Привет, сэр, куда я могу положить этот код? спасибо

PrianCarlos BoqRad RemSer

какую ссылку нужно добавить для запуска этого кода? заранее спасибо