|
-
Apr 3rd, 2011, 07:57 AM
#1
Thread Starter
Lively Member
Saving workbook to User Specified Location
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()
-
Apr 3rd, 2011, 12:05 PM
#2
Thread Starter
Lively Member
Re: Saving workbook to User Specified Location
-
Apr 4th, 2011, 09:16 AM
#3
Thread Starter
Lively Member
Re: Saving workbook to User Specified Location
I'm sure someone knows this..
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|