ExcelPreview ListView1, "郝南仁測試"
'--------------------------------------------------------------------------
'listView 導出成EXECL
'--------------------------------------------------------------------------
Public Sub ExcelPreview(ListView1 As ListView, vstrCaption As String)
'-----------------------------------------------------------------------------------------------
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
strCol = Chr(Asc("a") + ListView1.ColumnHeaders.Count - 1) '表格的列
If ListView1.ListItems.Count = 0 Then Exit Sub
'FrmMain.CommonDialog1.Filter = "Excel (*.xls)|*.xls"
Set mobjExcel = New Excel.Application
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]
Form2.ProgressBar1.value = i
Form2.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
Form2.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.ActiveSheet.PageSetup
' .TopMargin = 0.5 / 0.035 '設置頁面邊距
' .BottomMargin = 1 / 0.035
' .LeftMargin = 0.5 / 0.035
' .RightMargin = 0.5 / 0.035
' .CenterHorizontally = True '整頁居中
' 'mobjWorkBook.SaveAs FrmMain.CommonDialog1.FileName'保存到硬盤
' .Orientation = xlPortrait 'xlLandscape'打印方向
' .PaperSize = xlPaperA3 '紙張大小
' End With
With mobjExcel
.caption = "打印預覽" '設置預覽窗口的 標題
.Visible = True '顯示
' .ActiveSheet.PrintPreview
'.ActiveSheet.PrintOut'直接打印
.DisplayAlerts = False
'.Quit
End With
Set mobjExcel = Nothing
Form2.Hide
Exit Sub
Err1:
' 'MsgBox Err.Description & ":" & Err.Number, vbExclamation, "錯誤"
Set mobjExcel = Nothing
MsgBox err.Description
End Sub