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