Codejock Forums Homepage
Forum Home Forum Home > Codejock Products > ActiveX COM > Report Control
  New Posts New Posts RSS Feed - Export to Excel
  FAQ FAQ  Forum Search   Events   Register Register  Login Login

Export to Excel

 Post Reply Post Reply
Author
Message
Gerlis View Drop Down
Newbie
Newbie
Avatar

Joined: 22 October 2013
Location: São Paulo
Status: Offline
Points: 5
Post Options Post Options   Thanks (0) Thanks(0)   Quote Gerlis Quote  Post ReplyReply Direct Link To This Post Topic: Export to Excel
    Posted: 23 October 2013 at 3:44pm
Good afternoon guys,
anyone of you could export the data ReportControl to Excel?
if so how was the procedure done, I'm sure but me must have people interested in this role.
hug!
< id="adlesse_unifier_magic_element_id" style="display: none;">
Back to Top
Xander75 View Drop Down
Senior Member
Senior Member
Avatar

Joined: 26 April 2007
Status: Offline
Points: 353
Post Options Post Options   Thanks (1) Thanks(1)   Quote Xander75 Quote  Post ReplyReply Direct Link To This Post Posted: 07 March 2014 at 3:18am
Hi,

I use the below reusable code for all my Export to Excel needs:

' Use one of the following to export what you need
Call ExportToExcel(ReportControl) ' Exports the ReportControl
Call ExportToExcel(ReportControl, true) ' Exports the ReportControl, but only the selected rows
Call ExportToExcel(ReportControl, , "10,11,12") ' Exports the ReportControl, but ignores Columns 10 to 12
Call ExportToExcel(ReportControl, true, "10,11,12") ' Exports the ReportControl, but only the selected rows and ignores Columns 10 to 12

' PS. The ignore Columns can be anything you want like 1,4,9,20 as long as it corresponds to a column in the ReportControl. You also must use the Microsoft Excel Reference within your Project.

' The reusable ExportToExcel procedure
Public Sub ExportToExcel(rpc As ReportControl, Optional ExportOnlySelected As Boolean = False, Optional IgnoreCols As String = vbNullString)
    Dim Record As ReportRecord
    Dim xlsApp As Excel.Application
    Dim xlsWSheet As Excel.Worksheet
    Dim i As Long, j As Long, x As Long, z As Long
   
    ' Get or Create Excel Object
    On Error Resume Next
    Set xlsApp = GetObject(, "Excel.Application")

    If Err.Number <> 0 Then
        Set xlsApp = New Excel.Application
        Err.Clear
    End If

    ' Create the WorkSheet
    Set xlsWSheet = xlsApp.Workbooks.Add.ActiveSheet
   
    With xlsWSheet

        ' Export Data from the ReportControl
        If ExportOnlySelected Then
            x = 1

            For i = 0 To rpc.Records.Count - 1
                If rpc.Rows(i).Selected Then
                    x = x + 1
                    z = 1
                   
                    Set Record = rpc.Records.Record(i)
                    For j = 1 To rpc.Columns.Count
                        If Not InstrEx(IgnoreCols, CStr(j - 1), ",") Then
                            .Cells(x, z) = Record.Item(j - 1).Value
                            .Cells(x, z) = IIf(Len(Record.Item(j - 1).Value) = 6, "01/" & Format$(CStr(Record.Item(j - 1).Value), "mm/yyyy"), CStr(Record.Item(j - 1).Value))
                       
                            If Trim$(CStr(Record.Item(j - 1).Value)) = vbNullString And Record.Item(j - 1).Icon > -1 Then
                                .Cells(x, z) = CStr(Record.Item(j - 1).Tag)
                            End If
                           
                            ' Format the Cell, if the value is a number then format as such otherwise format as text
                            Select Case IsNumeric(Record.Item(j - 1).Value)
                                Case False
                                    Select Case IsDate(Record.Item(j - 1).Value)
                                        Case False
                                            .Cells(x, z).NumberFormat = "@"
                                        Case True
                                            If Len(Record.Item(j - 1).Value) = 6 Then
                                                .Cells(i + 2, z).NumberFormat = "@"
                                                .Cells(i + 2, z) = CStr(Record.Item(j - 1).Value)
                                            Else
                                                .Cells(i + 2, z).NumberFormat = "dd/mm/yyyy"
                                                .Cells(i + 2, z) = Format$(.Cells(i + 2, z), "dd/mm/yyyy")
                                            End If
                                    End Select
                                Case True
                                    .Cells(x, z).NumberFormat = "#,##0"
                            End Select
                        End If
                       
                        z = z + 1
                    Next
                End If
            Next
        Else
            For i = 0 To rpc.Records.Count - 1
                z = 1
                Set Record = rpc.Records.Record(i)
                For j = 1 To rpc.Columns.Count
                    If Not InstrEx(IgnoreCols, CStr(j - 1), ",") Then
                        .Cells(i + 2, z) = CStr(Record.Item(j - 1).Value)
                        '.Cells(i + 2, z) = IIf(Len(Record.Item(j - 1).Value) = 6, "01/" & Format$(CStr(Record.Item(j - 1).Value), "mm/yyyy"), CStr(Record.Item(j - 1).Value))
                       
                        If Trim$(CStr(Record.Item(j - 1).Value)) = vbNullString And Record.Item(j - 1).Icon > -1 Then
                            .Cells(i + 2, z) = CStr(Record.Item(j - 1).Tag)
                        End If
   
                        ' Format the Cell, if the value is a number then format as such otherwise format as text
                        Select Case IsNumeric(Record.Item(j - 1).Value)
                            Case False
                                Select Case IsDate(Record.Item(j - 1).Value)
                                    Case False
                                        .Cells(i + 2, z).NumberFormat = "@"
                                    Case True
                                        If Len(Record.Item(j - 1).Value) = 6 Then
                                            .Cells(i + 2, z).NumberFormat = "@"
                                            .Cells(i + 2, z) = CStr(Record.Item(j - 1).Value)
                                        Else
                                            .Cells(i + 2, z).NumberFormat = "dd/mm/yyyy"
                                            .Cells(i + 2, z) = Format$(.Cells(i + 2, z), "dd/mm/yyyy")
                                        End If
                                End Select
                            Case True
                                .Cells(i + 2, z).NumberFormat = "#,##0"
                        End Select
                       
                        z = z + 1
                    End If
                Next
            Next
        End If

        ' Format the Columns
        z = 0
        For i = 0 To rpc.Columns.Count - 1
            If Not InstrEx(IgnoreCols, CStr(i), ",") Then
                ' Export ColumnHeaders & set as bold
                .Cells(1, z + 1) = rpc.Columns(i).Caption
                .Cells(1, z + 1).Font.Bold = True
           
                ' Autofit column headers
                .Columns(z + 1).AutoFit
               
                ' Format the Column Alignments
                Select Case rpc.Columns.Column(i).Alignment
                    Case xtpAlignmentCenter
                        .Columns(z + 1).HorizontalAlignment = xlCenter
                    Case xtpAlignmentRight
                        .Columns(z + 1).HorizontalAlignment = xlRight
                    Case Else
                        .Columns(z + 1).HorizontalAlignment = xlLeft
                End Select
               
                z = z + 1
            End If
           
        Next
   
        ' Move to first cell to unselect
        .Range("A1").Select
    End With
  
    ' Show the Excel Window
    With xlsApp
        .ActiveWindow.SplitRow = 1
        .Windows(1).FreezePanes = True
        .Visible = True
    End With
   
    Set xlsApp = Nothing
    Set xlsWSheet = Nothing
End Sub

Product: Xtreme SuitePro (ActiveX) v15.3.1
Platform: Windows 7 64-bit (SP1) Professional Edition
Languages: C#.Net using Visual Studio 2012 & Visual Basic 6.0 (SP6)
Back to Top
 Post Reply Post Reply
  Share Topic   

Forum Jump Forum Permissions View Drop Down

Forum Software by Web Wiz Forums® version 12.04
Copyright ©2001-2021 Web Wiz Ltd.

This page was generated in 0.172 seconds.