-
Nov 29th, 2005, 07:36 AM
#1
(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:
Private Sub subExportToExcel(pGrilla As Integer)
Dim i As Long
Dim p As Long
Dim newCell As String
Dim xl As Object
Dim lcont As Integer
Dim v As Integer
On Error GoTo Error_Here
Screen.MousePointer = vbHourglass
lcont = 0
With Flex.Item(pGrilla) 'this Flexgrid from the Array of Flexgrids
If .Rows <= 2 Then
Screen.MousePointer = vbDefault
Exit Sub
End If
Set xl = CreateObject("excel.application")
xl.Workbooks.Add
DoEvents
'Title row settings: bold, color, alignment
xl.Worksheets(1).Range("A1:AB1").Select
With xl.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.Interior.ColorIndex = 55
.Interior.Pattern = xlSolid
.Font.ColorIndex = 2
.Font.Bold = True
'Gridlines format
For v = 7 To 10
With .Borders(v)
If v <= 10 Then
.LineStyle = xlContinuous
.Weight = xlThin
End If
End With
Next
End With
'Add column numbers one by one
For p = 0 To 27
If p < 26 Then newCell = Chr(p + 65) & "1" Else newCell = "A" & Chr(p - 26 + 65) & "1"
xl.Worksheets(1).Range(newCell).Value = .TextMatrix(0, p)
xl.Worksheets(1).Range(newCell).Select
If p = 0 Then
xl.Selection.ColumnWidth = 20
Else
xl.Selection.ColumnWidth = Len(.TextMatrix(0, p)) + 3
End If
Next
For i = 2 To .Rows
'Format cells (if its not a Title row)
If lcont <> 0 Then
'Number format from column E
xl.Worksheets(1).Range("E" & CStr(i) & ":AB" & CStr(i)).Select
With xl.Selection
.NumberFormat = "0.000"
End With
'Center align, all columns except the first
xl.Worksheets(1).Range("B" & CStr(i) & ":AB" & CStr(i)).Select
With xl.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With
End If
For p = 0 To .Cols - 1
.Row = i - 1
.Col = p
If p < 26 Then newCell = Chr(p + 65) & i Else newCell = "A" & Chr(p - 26 + 65) & i
If lcont = 0 Then
xl.Worksheets(1).Range(newCell).Value = .Text
Else
xl.Worksheets(1).Range(newCell).Value = Replace(.Text, ",", ".")
End If
If lcont = 0 Then
xl.Worksheets(1).Range(newCell).Font.Bold = True
xl.Worksheets(1).Range(newCell).Font.Color = vbBlue
lcont = 3
Exit For
End If
Next
If lcont = 3 Then
xl.Worksheets(1).Range("A" & CStr(i) & ":AB" & CStr(i)).Select
With xl.Selection.Interior
.ColorIndex = 37
.Pattern = xlSolid
End With
For v = 7 To 10
With xl.Selection.Borders(v)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Next
End If
lcont = lcont - 1
Next
End With
'Finishes leaving 1st cell selected
xl.Worksheets(1).Range("A1").Select
Screen.MousePointer = vbDefault
xl.Visible = True 'Show workbook
Exit Sub
Error_Here:
If xl Is Nothing Then
Call MsgBox("Error initializing Microsoft Excel", vbExclamation + vbOKOnly, "Error")
End If
Screen.MousePointer = vbDefault
End Sub
Last edited by jcis; Nov 29th, 2005 at 08:11 AM.
-
Nov 29th, 2005, 07:41 AM
#2
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:
Dim i As Long
Dim p As Long
Dim newCell As String
Dim xl As Excel.Application
Set xl = CreateObject("excel.application")
xl.Workbooks.Open (App.Path & "\Book1")
DoEvents
xl.Visible = True
For i = 1 To MSFlexGrid1.Rows - 1
For p = 1 To MSFlexGrid1.Cols - 1
MSFlexGrid1.Col = p
MSFlexGrid1.Row = i
newCell = Chr(i + 64) & p
xl.Worksheets("Sheet1").Range(newCell).Value = MSFlexGrid1.Text
Next
Next
-
Nov 29th, 2005, 07:55 AM
#3
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.
-
Nov 29th, 2005, 07:58 AM
#4
Re: Exporting from MSFlexgrid to Excel. This is taking ages..
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.)
-
Nov 29th, 2005, 08:11 AM
#5
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.
-
Nov 29th, 2005, 08:14 AM
#6
Re: Exporting from MSFlexgrid to Excel. This is taking ages..
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.
-
Dec 4th, 2005, 09:36 PM
#7
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:
Private Sub subCreateXls(pTextFile As String, pStrExcelFile As String)
Dim lObjExcel As Object
Set lObjExcel = CreateObject("Excel.Application") 'Create the Excel Object
lObjExcel.DisplayAlerts = False
lObjExcel.Visible = False
' Open the Tab delimited TXT file in Excel
' This code was generated with a Macro, It goes to from 1 to 28 because
' my TXT File has 28 values per line (separated with vbTab)
lObjExcel.Workbooks.OpenText FileName:=pTextFile, Origin:=xlMSDOS, StartRow:= _
1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _
Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array( _
16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), _
Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array(28, 1)), _
TrailingMinusNumbers:=True
'Save as .XLS, this was also generated with a Macro
lObjExcel.ActiveWorkbook.SaveAs FileName:=pStrExcelFile, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
'Destroy the TXT (if you want)
Kill pTextFile
'Show Excel
lObjExcel.Visible = True
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
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|