listview导出到Excel

导出数据时,用到了Excel来接收数据,首先在VB6中引用Excel

然后定义

        Dim mobjExcel     As Excel.Application

        Dim mobjWorkBook     As Excel.Workbook

        Dim strListItem     As String

        Dim strCol     As String

        Dim lngMaxLine     As Long     '表格的行数

        Dim i     As Long

        Dim j     As Long

On Error GoTo Err1      错误处理

              If ListView1.ListItems.Count = 0 Then Exit Sub

              With mobjExcel

  

              .SheetsInNewWorkbook = 1

              Set mobjWorkBook = .Workbooks.Add

              .ActiveSheet.Cells(1, 1) = vstrCaption

              For i = 1 To ListView1.ColumnHeaders.Count

                    .ActiveSheet.Cells(2, i) = ListView1.ColumnHeaders(i).Text

              Next i

              For i = 1 To ListView1.ListItems.Count

                '-------------------------------------

                '导出当前处理到那一条记录     [窗口2]

                SetParent frmProgress.hWnd, fMainForm.hWnd               进度条显示

                frmProgress.Show

                frmProgress.ProgressBar1.Value = i

                frmProgress.Label2.Caption = i

                    strListItem = ListView1.ListItems(i).Text

                    .ActiveSheet.Cells(i + 2, 1).Value = strListItem

                    For j = 1 To ListView1.ColumnHeaders.Count - 1

                          strListItem = ListView1.ListItems(i).SubItems(j)  最关键的添加数据

                          .ActiveSheet.Cells(i + 2, j + 1).Value = strListItem

                        frmProgress.Label2.Caption = i & ":" & j

                    Next j

              lngMaxLine = i + 2

              Next i

        End With

        With mobjExcel.ActiveSheet

              .Cells(1, 1).Font.Size = 18

              .Cells(1, 1).HorizontalAlignment = xlVAlignCenter         '   居中

              .Range("a1").Font.Bold = True

              .Range("a1").RowHeight = 36

              .Range("a2:" & strCol & "2").Font.Bold = True               '粗体

              .Range("a2:a" & lngMaxLine).Font.Bold = True                  '第一列为粗体

              .Range("a1:" & strCol & "1").MergeCells = True               '合并单元格

        End With

        With mobjExcel.ActiveSheet.Range("a2:" & strCol & lngMaxLine).Borders             '加表格

              .LineStyle = 0

              .Weight = 2

        End With

        With mobjExcel

              For i = 1 To ListView1.ColumnHeaders.Count             '设置列宽

                    .ActiveSheet.Range(Chr(Asc("a") + i - 1) & "2").ColumnWidth = ListView1.ColumnHeaders(i).Width * 0.008

                    .ActiveSheet.Range("a1:" & strCol & lngMaxLine).HorizontalAlignment = xlVAlignCenter

              Next i

        End With

        With mobjExcel

              .Caption = "打印预览"             '设置预览窗口的         标题

              .Visible = True       '显示

              .DisplayAlerts = False

        End With

        Set mobjExcel = Nothing

        frmProgress.Hide

        Exit Sub

Err1:

  '       'MsgBox   Err.Description   &   ":"   &   Err.Number,   vbExclamation,   "错误"

        Set mobjExcel = Nothing

        MsgBox Err.Description

  End Sub

 

©️2020 CSDN 皮肤主题: 大白 设计师:CSDN官方博客 返回首页