Export ListView To Excel

Public Function ExportListViewToExcel(ByVal MyListView As Windows.Forms.ListView)
2: 
3:    '=========================================================================
4:    '== This is our Exvel Class ==
5:    '== Remember to add a refrence to Microsoft Excel XX.XX Object Libary ==
6:    '=========================================================================
7:    Dim ExcelReport As Excel.ApplicationClass
8: 
9:    '=========================================================================================
10:    '== TMAX_COLOURS is the masimum amount of colours excel will let us save in the palet ==
11:    '=========================================================================================
12:    Const MAX_COLOURS As Int16 = 40
13: 
14:    '=======================================================================
15:    '== Excel will only allow 25 colums per sheet (starting at 0 = 254) ==
16:    '=======================================================================
17:    Const MAX_COLUMS As Int16 = 254
18: 
19:    '=====================================================
20:    '== Simple counter to count itesm in our listview ==
21:    '=====================================================
22:    Dim i As Integer
23:    Dim New_Item As Windows.Forms.ListViewItem
24: 
25:    '==========================================================
26:    '== The Colum Letter(and number) we are on and the row ==
27:    '==========================================================
28:    Dim TempColum As Int16
29:    Dim ColumLetter As String
30:    Dim TempRow As Int16
31:    Dim TempColum2 As Int16
32: 
33:    '=============================================
34:    '== Colours we have added to Excels palet ==
35:    '=============================================
36:    Dim AddedColours As Int16 = 1
37:    Dim MyColours As Hashtable = New Hashtable
38: 
39:    '===========================================================================
40:    '== Variables to control if we need to add a new colour to Excels palet ==
41:    '===========================================================================
42:    Dim AddNewBackColour As Boolean = True
43:    Dim AddNewFrontColour As Boolean = True
44:    Dim BackColour As String
45:    Dim FrontColour As String
46: 
47:    '============================================================
48:    '== Setup our Excel Class and open a new workbook to use ==
49:    '============================================================
50:    ExcelReport = New Excel.ApplicationClass
51: 
52:    '-- Setting this to false and then resetting it to true at the end will stop
53:    '-- a user clicking around in excel and causing a possible error
54:    ExcelReport.Visible = True
55:   
56:    ExcelReport.Workbooks.Add()
57:    ExcelReport.Worksheets("Sheet1").Select()
58:    ExcelReport.Sheets("Sheet1").Name = MyListView.Name
59: 
60:    '=======================================================
61:    '== Add all the colums from the listview into Excel ==
62:    '=======================================================
63:    i = 0
64:    Do Until i = MyListView.Columns.Count
65: 
66:     '==========================================================================
67:     '== Work out which colum we are on ==
68:     '== The Colums Go from A-Z and to IV, so A-Z to AA-AZ to BA-BZ etc etc ==
69:     '==========================================================================
70:     If i > MAX_COLUMS Then
71: 
72:      MsgBox("Too many Colums added")
73:      Exit Do
74: 
75:     End If
76:     TempColum = i
77:     TempColum2 = 0
78:     Do While TempColum > 25
79: 
80:      TempColum -= 26
81:      TempColum2 += 1
82: 
83:     Loop
84: 
85:     ColumLetter = Chr(97 + TempColum)
86:     If TempColum2 > 0 Then ColumLetter = Chr(96 + TempColum2) & ColumLetter
87: 
88:     '=======================================================
89:     '== Add all the colums from the listview into Excel ==
90:     '=======================================================
91:     ExcelReport.Range(ColumLetter & 1).Value = MyListView.Columns(i).Text
92:     ExcelReport.Range(ColumLetter & 1).Font.Name = MyListView.Font.Name
93:     ExcelReport.Range(ColumLetter & 1).Font.Size = MyListView.Font.Size
94:     i += 1
95: 
96:    Loop
97: 
98:    '==================================================================================
99:    '== Move to the second row in Excel and get all the items out of the list view ==
100:    '==================================================================================
101:    TempRow = 2
102:    For Each New_Item In MyListView.Items
103: 
104:     i = 0
105:     Do Until i = New_Item.SubItems.Count
106: 
107:      '==========================================================================
108:      '== Work out which colum we are on ==
109:      '== The Colums Go from A-Z and to IV, so A-Z to AA-AZ to BA-BZ etc etc ==
110:      '==========================================================================
111:      If i > MAX_COLUMS Then
112: 
113:       MsgBox("Too many Colums added")
114:       Exit Do
115: 
116:      End If
117: 
118:      TempColum = i
119:      TempColum2 = 0
120: 
121:      Do While TempColum > 25
122: 
123:       TempColum -= 26
124:       TempColum2 += 1
125: 
126:      Loop
127: 
128:      ColumLetter = Chr(97 + TempColum)
129:      If TempColum2 > 0 Then ColumLetter = Chr(96 + TempColum2) & ColumLetter
130: 
131:      '===========================================================================
132:      '== Add all the List View colums into Excel ==
133:      '== We also get the List Views font type and size and set it to the row ==
134:      '===========================================================================
135:      ExcelReport.Range(ColumLetter & TempRow).Value = New_Item.SubItems(i).Text
136:      ExcelReport.Range(ColumLetter & TempRow).Font.Name = New_Item.Font.Name
137:      ExcelReport.Range(ColumLetter & TempRow).Font.Size = New_Item.Font.Size
138: 
139:      '============================================================
140:      '== Reset the check to see if we have found a new colour ==
141:      '============================================================
142:      AddNewFrontColour = False
143:      AddNewBackColour = False
144:      Try
145: 
146:       '===================================================================
147:       '== Check our Colours Hashtable for a colour with the same name ==
148:       '== as the backcolour of our listview item ==
149:       '===================================================================
150:       BackColour = MyColours(New_Item.BackColor.ToString)
151:       If BackColour = "" Then AddNewBackColour = True
152: 
153:       '===================================================================
154:       '== Check our Colours Hashtable for a colour with the same name ==
155:       '== as the Text colour of our listview item ==
156:       '===================================================================
157:       FrontColour = MyColours(New_Item.ForeColor.ToString)
158:       If FrontColour = "" Then AddNewFrontColour = True
159: 
160:      Catch ex As Exception
161: 
162:       AddNewFrontColour = False
163:       AddNewBackColour = False
164: 
165:      End Try
166: 
167:      '=========================================================================
168:      '== If there is room for new colours and we have found some, add them ==
169:      '== to Excels palet ==
170:      '=========================================================================
171:      If AddedColours <> -1) Then
172: 
173:       If AddNewBackColour Then
174: 
175:        MyColours.Add(New_Item.BackColor.ToString, AddedColours)
176:        ExcelReport.Workbooks.Item(1).Colors(AddedColours) = RGB(New_Item.BackColor.R, New_Item.BackColor.G, New_Item.BackColor.B)
177:        AddedColours += 1
178: 
179:       End If
180: 
181:       If AddNewFrontColour Then
182: 
183:        MyColours.Add(New_Item.ForeColor.ToString, AddedColours)
184:        ExcelReport.Workbooks.Item(1).Colors(AddedColours) = RGB(New_Item.ForeColor.R, New_Item.ForeColor.G, New_Item.ForeColor.B)
185:        AddedColours += 1
186: 
187:       End If
188: 
189:      End If
190: 
191:      '========================================================================
192:      '== Now all we need to do it select the rown and set the two colours ==
193:      '== Interior is back backgrounf and Font is the font colour ==
194:      '========================================================================
195:      ExcelReport.Rows(TempRow & ":" & TempRow).select()
196:      ExcelReport.Selection.Interior.ColorIndex = MyColours(New_Item.BackColor.ToString)
197:      ExcelReport.Selection.Font.ColorIndex = MyColours(New_Item.ForeColor.ToString)
198: 
199:      i += 1
200: 
201:     Loop
202:     TempRow += 1
203: 
204:    Next
205: 
206:    '=======================================================================
207:    '== Now all thats left to do is select all the colums and rows ==
208:    '== Resize them to so they are all the right widths to see the data ==
209:    '== and finaly select from A1 so the user is taken to the start ==
210:    '=======================================================================
211:    ExcelReport.Cells.Select()
212:    ExcelReport.Cells.EntireColumn.AutoFit()
213:    ExcelReport.Cells.Range("A1").Select()
214: 
215:   End Function
216: 
/code]