Results 1 to 7 of 7

Thread: (RESOLVED) Exporting from MSFlexgrid to Excel. This is taking ages..

  1. #1

    Thread Starter
    PowerPoster jcis's Avatar
    Join Date
    Jan 2003
    Location
    Argentina
    Posts
    4,430

    Resolved (RESOLVED) Exporting from MSFlexgrid to Excel. This is taking ages..

    I have a flexgrid with rows merged. The content is in this format:

    Row1 - TITLE ROW - (merged) contains a Title: "Item1 - Item2"
    Row2: Row for Item1
    Row3: Row Item2

    Row 4 - TITLE ROW - (merged) contains a Title: "Item3 - Item4"
    Row5: Row for Item3
    Row6: Row Item4

    ..and so on, Its: Title, 1 item, another Item.. and repeating.

    When I export to Excel I need to preserve that format, using diferente colors for Titles, Formating numbers, change some gridlines, else, it would be illegible.

    Well, the problem is its take to long to fill the worksheet, i.e. if my flexgrid has 200 - 300 rows, it takes between 1 and 2 minutes to fill the worksheet
    I've done this based on the Macro code.
    Is there a faster way to do it?

    VB Code:
    1. Private Sub subExportToExcel(pGrilla As Integer)
    2. Dim i        As Long
    3. Dim p        As Long
    4. Dim newCell  As String
    5. Dim xl       As Object
    6. Dim lcont    As Integer
    7. Dim v        As Integer
    8.  
    9. On Error GoTo Error_Here
    10.    
    11.     Screen.MousePointer = vbHourglass
    12.     lcont = 0
    13.     With Flex.Item(pGrilla) 'this Flexgrid from the Array of Flexgrids
    14.    
    15.         If .Rows <= 2 Then
    16.             Screen.MousePointer = vbDefault
    17.             Exit Sub
    18.         End If
    19.        
    20.         Set xl = CreateObject("excel.application")
    21.             xl.Workbooks.Add
    22.             DoEvents
    23.                
    24.         'Title row settings: bold, color, alignment
    25.         xl.Worksheets(1).Range("A1:AB1").Select
    26.         With xl.Selection
    27.                 .HorizontalAlignment = xlCenter
    28.                 .VerticalAlignment = xlBottom
    29.                 .Interior.ColorIndex = 55
    30.                 .Interior.Pattern = xlSolid
    31.                 .Font.ColorIndex = 2
    32.                 .Font.Bold = True
    33.            
    34.             'Gridlines format
    35.             For v = 7 To 10
    36.                 With .Borders(v)
    37.                     If v <= 10 Then
    38.                         .LineStyle = xlContinuous
    39.                         .Weight = xlThin
    40.                     End If
    41.                 End With
    42.             Next
    43.         End With
    44.        
    45.         'Add column numbers one by one
    46.         For p = 0 To 27
    47.             If p < 26 Then newCell = Chr(p + 65) & "1" Else newCell = "A" & Chr(p - 26 + 65) & "1"
    48.             xl.Worksheets(1).Range(newCell).Value = .TextMatrix(0, p)
    49.             xl.Worksheets(1).Range(newCell).Select
    50.             If p = 0 Then
    51.                 xl.Selection.ColumnWidth = 20
    52.             Else
    53.                 xl.Selection.ColumnWidth = Len(.TextMatrix(0, p)) + 3
    54.             End If
    55.         Next
    56.        
    57.         For i = 2 To .Rows
    58.             'Format cells (if its not a Title row)
    59.             If lcont <> 0 Then
    60.                 'Number format from column E
    61.                 xl.Worksheets(1).Range("E" & CStr(i) & ":AB" & CStr(i)).Select
    62.                 With xl.Selection
    63.                     .NumberFormat = "0.000"
    64.                 End With
    65.                
    66.                 'Center align, all columns except the first
    67.                 xl.Worksheets(1).Range("B" & CStr(i) & ":AB" & CStr(i)).Select
    68.                 With xl.Selection
    69.                     .HorizontalAlignment = xlCenter
    70.                     .VerticalAlignment = xlBottom
    71.                 End With
    72.             End If
    73.                    
    74.             For p = 0 To .Cols - 1
    75.                     .Row = i - 1
    76.                     .Col = p
    77.                     If p < 26 Then newCell = Chr(p + 65) & i Else newCell = "A" & Chr(p - 26 + 65) & i
    78.                     If lcont = 0 Then
    79.                         xl.Worksheets(1).Range(newCell).Value = .Text
    80.                     Else
    81.                         xl.Worksheets(1).Range(newCell).Value = Replace(.Text, ",", ".")
    82.                     End If
    83.                                        
    84.                     If lcont = 0 Then
    85.                         xl.Worksheets(1).Range(newCell).Font.Bold = True
    86.                         xl.Worksheets(1).Range(newCell).Font.Color = vbBlue
    87.                         lcont = 3
    88.                         Exit For
    89.                     End If
    90.             Next
    91.            
    92.             If lcont = 3 Then
    93.                 xl.Worksheets(1).Range("A" & CStr(i) & ":AB" & CStr(i)).Select
    94.                 With xl.Selection.Interior
    95.                     .ColorIndex = 37
    96.                     .Pattern = xlSolid
    97.                 End With
    98.                 For v = 7 To 10
    99.                     With xl.Selection.Borders(v)
    100.                         .LineStyle = xlContinuous
    101.                         .Weight = xlThin
    102.                         .ColorIndex = xlAutomatic
    103.                     End With
    104.                 Next
    105.             End If
    106.            
    107.             lcont = lcont - 1
    108.         Next
    109.     End With
    110.    
    111.     'Finishes leaving 1st cell selected
    112.     xl.Worksheets(1).Range("A1").Select
    113.     Screen.MousePointer = vbDefault
    114.     xl.Visible = True 'Show workbook
    115.  
    116. Exit Sub
    117. Error_Here:
    118.     If xl Is Nothing Then
    119.         Call MsgBox("Error initializing Microsoft Excel", vbExclamation + vbOKOnly, "Error")
    120.     End If
    121.     Screen.MousePointer = vbDefault
    122. End Sub
    Last edited by jcis; Nov 29th, 2005 at 08:11 AM.

  2. #2
    I'm about to be a PowerPoster! Hack's Avatar
    Join Date
    Aug 2001
    Location
    Searching for mendhak
    Posts
    58,333

    Re: Exporting from MSFlexgrid to Excel. This is taking ages..

    I don't know if this is faster, but the code is shorter.
    VB Code:
    1. Dim i As Long
    2. Dim p As Long
    3. Dim newCell As String
    4. Dim xl As Excel.Application
    5. Set xl = CreateObject("excel.application")
    6.     xl.Workbooks.Open (App.Path & "\Book1")
    7.     DoEvents
    8.     xl.Visible = True
    9. For i = 1 To MSFlexGrid1.Rows - 1
    10.     For p = 1 To MSFlexGrid1.Cols - 1
    11.         MSFlexGrid1.Col = p
    12.         MSFlexGrid1.Row = i
    13.         newCell = Chr(i + 64) & p
    14.         xl.Worksheets("Sheet1").Range(newCell).Value = MSFlexGrid1.Text
    15.     Next
    16. Next

  3. #3

    Thread Starter
    PowerPoster jcis's Avatar
    Join Date
    Jan 2003
    Location
    Argentina
    Posts
    4,430

    Re: Exporting from MSFlexgrid to Excel. This is taking ages..

    Thanks Hack. The thing is, that was my basecode, I copied that code from one of your posts, then I begun adding things to fit my needs, resulting that big sub of my previous post. I think Ill have to remove some Selection formating, thats what's making it so slow.

  4. #4
    I'm about to be a PowerPoster! Hack's Avatar
    Join Date
    Aug 2001
    Location
    Searching for mendhak
    Posts
    58,333

    Re: Exporting from MSFlexgrid to Excel. This is taking ages..

    Quote Originally Posted by jcis
    Thanks Hack. The thing is, that was my basecode, I copied that code from one of your posts, then I begun adding things to fit my needs, resulting that big sub of my previous post. I think Ill have to remove some Selection formating, thats what's making it so slow.
    Ok.

    Would it be faster to do no formatting during the loading, and then do the formatting via an Excel Macro after the sheet was done? (I have no idea, it is just something I'm throwing out as a suggestion.)

  5. #5

    Thread Starter
    PowerPoster jcis's Avatar
    Join Date
    Jan 2003
    Location
    Argentina
    Posts
    4,430

    Re: Exporting from MSFlexgrid to Excel. This is taking ages..

    Yes, that would be the best. I'll just need the row count, then its TITLE, ITEM1, ITEM2.. and repeating. It should be faster doing it at the end and not on the fly. I'll try. Thanks.

  6. #6
    I'm about to be a PowerPoster! Hack's Avatar
    Join Date
    Aug 2001
    Location
    Searching for mendhak
    Posts
    58,333

    Re: Exporting from MSFlexgrid to Excel. This is taking ages..

    Quote Originally Posted by jcis
    Yes, that would be the best. I'll just need the row count, then its TITLE, ITEM1, ITEM2.. and repeating. It should be faster doing it at the end and not on the fly. I'll try. Thanks.
    If you come up with a slick solution, post the macro code as it may benefit someone else facing a similiar situation.

  7. #7

    Thread Starter
    PowerPoster jcis's Avatar
    Join Date
    Jan 2003
    Location
    Argentina
    Posts
    4,430

    Re: (RESOLVED) Exporting from MSFlexgrid to Excel. This is taking ages..

    Well, just to say I found a solution. the Formating thing is slow, but that wasn't the problem, Excel is extremely slow when adding values 1 by 1, cell by cell. So I realize that I could create a TXT file, TAB delimited, open that file with Excel, with proper configuration, and then save the file as .XLS (Excel format).

    Using the code in my first post was taking minutes with only 300 - 400 rows, now it takes seconds with 1000's of rows.

    So, first, I create a TXT file using vbTab to separate values, and save that file to disk, then I open that file with Excel, and save it as XLS, this way:
    VB Code:
    1. Private Sub subCreateXls(pTextFile As String, pStrExcelFile As String)
    2. Dim lObjExcel        As Object
    3.  
    4. Set lObjExcel = CreateObject("Excel.Application") 'Create the Excel Object
    5.     lObjExcel.DisplayAlerts = False
    6.     lObjExcel.Visible = False
    7.    
    8.     ' Open the Tab delimited TXT file in Excel
    9.     ' This code was generated with a Macro, It goes to from 1 to 28 because
    10.     ' my TXT File has 28 values per line (separated with vbTab)
    11.     lObjExcel.Workbooks.OpenText FileName:=pTextFile, Origin:=xlMSDOS, StartRow:= _
    12.         1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
    13.         ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
    14.         , Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
    15.         Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
    16.         Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array( _
    17.         16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), _
    18.         Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array(28, 1)), _
    19.         TrailingMinusNumbers:=True
    20.    
    21.     'Save as .XLS, this was also generated with a Macro
    22.     lObjExcel.ActiveWorkbook.SaveAs FileName:=pStrExcelFile, FileFormat:=xlNormal, _
    23.         Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
    24.         CreateBackup:=False
    25.    
    26.     'Destroy the TXT (if you want)
    27.     Kill pTextFile
    28.    
    29.     'Show Excel
    30.     lObjExcel.Visible = True
    31. End Sub
    Last edited by jcis; Dec 4th, 2005 at 09:48 PM.

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