listview導出到excel，excel格式問題
小弟初來咋到，還請各位大哥大姐多多幫忙啊。。。
怎麼把listview的數據導出成如下的excel的格式？謝謝
格式如下, 第一次注冊問問題，，，
空個三五行（用與以後插入別的東西)
字段一 字段一
字段二 字段二
字段三 字段三
(空個三五行在重復)
[解决办法]
'导出到EXCEL（通过listview）
Sub OutPutExcel(sTitle As String, lvwList As ListView) ', Optional sAddCond As String = " ", Optional XtChart As MSChart20Lib.MSChart)
'------------------------$$$$$$$ In Proc
If lvwList.ListItems.Count = 0 Then GoTo ExitProc
Screen.MousePointer = vbHourglass
On Error GoTo ErrorHandle
Dim vbExcel As Object
Dim vbWorkSheet As Object
Dim RG As Object
Set vbExcel = CreateObject( "Excel.application ")
vbExcel.Workbooks.Add
vbExcel.Sheets.Add
Set vbWorkSheet = vbExcel.ActiveSheet
vbWorkSheet.Name = ". " & Trim(sTitle$)
Dim rr%, kk%
rr = 1
Dim LC&
Dim LC1&
Dim tlngAlign As Long
Dim NumHead As Integer
NumHead = 0
For LC = 1 To lvwList.ColumnHeaders.Count - 1
NumHead = NumHead + 1
If LC = 2 Then
NumHead = 3
End If
With vbWorkSheet.Cells(rr, LC)
.NumberFormatLocal = "@ "
.Value = lvwList.ColumnHeaders(NumHead).Text
.Font.Bold = True
tlngAlign = lvwList.ColumnHeaders(NumHead).Alignment
.HorizontalAlignment = Switch(tlngAlign = 0, &HFFFFEFDD, tlngAlign = 2, &HFFFFEFF4, tlngAlign = 1, &HFFFFEFC8)
.VerticalAlignment = &HFFFFEFF4
End With
Next LC
kk = 1
For LC& = 1 To lvwList.ListItems.Count
With vbWorkSheet.Cells(rr + LC, kk)
.NumberFormatLocal = "@ "
tlngAlign = lvwList.ColumnHeaders(1).Alignment
.HorizontalAlignment = Switch(tlngAlign = 0, &HFFFFEFDD, tlngAlign = 2, &HFFFFEFF4, tlngAlign = 1, &HFFFFEFC8)
.VerticalAlignment = &HFFFFEFF4
.Value = lvwList.ListItems(LC)
End With
NumHead = 0
For LC1 = 1 To lvwList.ColumnHeaders.Count - 2
NumHead = NumHead + 1
With vbWorkSheet.Cells(rr + LC, kk + LC1)
.NumberFormatLocal = "@ "
tlngAlign = lvwList.ColumnHeaders(NumHead + 1).Alignment
.HorizontalAlignment = Switch(tlngAlign = 0, &HFFFFEFDD, tlngAlign = 2, &HFFFFEFF4, tlngAlign = 1, &HFFFFEFC8)
.VerticalAlignment = &HFFFFEFF4
.Value = lvwList.ListItems(LC).SubItems(NumHead)
End With
Next LC1
Next LC&
vbExcel.Visible = True
vbWorkSheet.Activate
Set RG = Nothing
Set vbExcel = Nothing
Set vbWorkSheet = Nothing
Screen.MousePointer = vbDefault
'sTitle 是标题, lvwList 是ListView
ExitProc:
Exit Sub
ErrorHandle:
MsgBox "无法导出数据，请确定您的系统已经安装Excel， ", vbOKCancel + vbExclamation, "导出错误 "
End Sub
