Results 1 to 3 of 3

Thread: Saving workbook to User Specified Location

  1. #1

    Thread Starter
    Lively Member
    Join Date
    Sep 2010
    Posts
    81

    Exclamation 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()

  2. #2

    Thread Starter
    Lively Member
    Join Date
    Sep 2010
    Posts
    81

    Re: Saving workbook to User Specified Location

    Anyone?

  3. #3

    Thread Starter
    Lively Member
    Join Date
    Sep 2010
    Posts
    81

    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
  •  



Click Here to Expand Forum to Full Width