Here's my code what do I need to add to Save the workbook as an Excel file to a user specified directory?
Code:Dim ExcelReport As Excel.ApplicationClass Dim i As Integer Dim New_Item As Windows.Forms.ListViewItem Const MAX_COLUMS As Int16 = 254 Const MAX_COLOURS As Int16 = 40 Dim AddedColours As Int16 = 1 Dim MyColours As Hashtable = New Hashtable Dim AddNewBackColour As Boolean = True Dim AddNewFrontColour As Boolean = True Dim BackColour As String Dim FrontColour As String Dim TempColum As Int16 Dim ColumLetter As String Dim TempRow As Int16 Dim TempColum2 As Int16 ExcelReport = New Excel.ApplicationClass ExcelReport.Workbooks.Add() ExcelReport.Worksheets("Sheet1").Select() ExcelReport.Sheets("Sheet1").Name = ListView1.Name i = 0 Do Until i = ListView1.Columns.Count If i > MAX_COLUMS Then MsgBox("Too many Colums added") Exit Do End If TempColum = i TempColum2 = 0 Do While TempColum > 25 TempColum -= 26 TempColum2 += 1 Loop ColumLetter = Chr(97 + TempColum) If TempColum2 > 0 Then ColumLetter = Chr(96 + TempColum2) & ColumLetter ExcelReport.Range(ColumLetter & 1).Value = ListView1.Columns(i).Text ExcelReport.Range(ColumLetter & 1).Font.Name = ListView1.Font.Name ExcelReport.Range(ColumLetter & 1).Font.Size = ListView1.Font.Size i += 1 Loop TempRow = 2 For Each New_Item In ListView1.Items i = 0 Do Until i = New_Item.SubItems.Count If i > MAX_COLUMS Then Exit Do End If TempColum = i TempColum2 = 0 Do While TempColum > 25 TempColum -= 26 TempColum2 += 1 Loop ColumLetter = Chr(97 + TempColum) If TempColum2 > 0 Then ColumLetter = Chr(96 + TempColum2) & ColumLetter '=========================================================================== '== Add all the List View colums into Excel == '== We also get the List Views font type and size and set it to the row == '=========================================================================== ExcelReport.Range(ColumLetter & TempRow).Value = New_Item.SubItems(i).Text ExcelReport.Range(ColumLetter & TempRow).Font.Name = New_Item.Font.Name ExcelReport.Range(ColumLetter & TempRow).Font.Size = New_Item.Font.Size '============================================================ '== Reset the check to see if we have found a new colour == '============================================================ AddNewFrontColour = False AddNewBackColour = False Try '=================================================================== '== Check our Colours Hashtable for a colour with the same name == '== as the backcolour of our listview item == '=================================================================== BackColour = MyColours(New_Item.BackColor.ToString) If BackColour = "" Then AddNewBackColour = True '=================================================================== '== Check our Colours Hashtable for a colour with the same name == '== as the Text colour of our listview item == '=================================================================== FrontColour = MyColours(New_Item.ForeColor.ToString) If FrontColour = "" Then AddNewFrontColour = True Catch ex As Exception AddNewFrontColour = False AddNewBackColour = False End Try '========================================================================= '== If there is room for new colours and we have found some, add them == '== to Excels palet == '========================================================================= If AddedColours < MAX_COLOURS And (AddNewFrontColour Or AddNewBackColour) And (New_Item.BackColor.ToArgb <> -1) Then If AddNewBackColour Then MyColours.Add(New_Item.BackColor.ToString, AddedColours) ExcelReport.Workbooks.Item(1).Colors(AddedColours) = RGB(New_Item.BackColor.R, New_Item.BackColor.G, New_Item.BackColor.B) AddedColours += 1 End If If AddNewFrontColour Then MyColours.Add(New_Item.ForeColor.ToString, AddedColours) ExcelReport.Workbooks.Item(1).Colors(AddedColours) = RGB(New_Item.ForeColor.R, New_Item.ForeColor.G, New_Item.ForeColor.B) AddedColours += 1 End If End If '======================================================================== '== Now all we need to do it select the rown and set the two colours == '== Interior is back backgrounf and Font is the font colour == '======================================================================== ExcelReport.Rows(TempRow & ":" & TempRow).select() ExcelReport.Selection.Interior.ColorIndex = MyColours(New_Item.BackColor.ToString) ExcelReport.Selection.Font.ColorIndex = MyColours(New_Item.ForeColor.ToString) i += 1 Loop TempRow += 1 Next '======================================================================= '== Now all thats left to do is select all the colums and rows == '== Resize them to so they are all the right widths to see the data == '== and finaly select from A1 so the user is taken to the start == '======================================================================= ExcelReport.Cells.Select() ExcelReport.Cells.EntireColumn.AutoFit() ExcelReport.Cells.Range("A1").Select()




Reply With Quote