• Home
 · 
• OLE/COM/DCOM/Active-X
 · 
• Port MSFlexiGrid Data To A Excel File

Port MSFlexiGrid Data To A Excel File

Port MSFlexiGrid Data To A Excel File

API Declarations


NOTE: STRICTLY FOR DEMONSTRATION PURPOSE ONLY



Rate Port MSFlexiGrid Data To A Excel File

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

Port Your Data To Excel - Made Easy [STRICTLY FOR DEMONSTRATION PURPOSE ONLY]


Author Name:		 Kannan C S
Category: 		 Intermediate
Development EnvironMent: Visual Basic 6.0
References and
Components Need:	 Excel Object Library 9.0
			 Common Dialog Control
Software Category:	 FreeWare

IMPORTANT: SOFTWARES NEEDED -  VISUAL BASIC 6.0, AND MS-EXCEL 9.0 OR LATER

Step - 1:
	Create a new Activex DLL Project
	Name: PortToXL
	OS Name: PortToExcel.vbp

	Set the component compatibility to Project Compatibility

Step - 2:
	
	Add a Form and set the following properties.

a)	Name: 		frmXLPort
	BackColor:	&H00FFC0C0&
	BorderStyle:    1-Fixed Single
	ClipControls:	False
	ControlBox:	False
	MinButton:	False
	MaxButton:	False
	Width:		4620
	Height:		1860

b)	Paste a Command Button with following Properties:
	Name:		cmdCancel
	Caption:	&Cancel
	BackColor:	&H00FFC0C0&
	Style:		Graphical

c)	Add the Common Dialog Control to the Form with the Following Properties:
	Name: cmdlgXlPortObject

	----------------------------------
	Add the following code in the form
	----------------------------------
	Private Sub cmdCancel_Click()
		boolStop = True
	End Sub

	Private Sub Form_Load()
		boolStop = False
		Me.Left = (Screen.Width - Me.Width) / 2
		Me.Top = (Screen.Height - Me.Height) / 2
	End Sub

Step - 3:
a)	Add a Class Module to your activex DLL Project with the following
	properties.
	
	Name:		PortToExcel
	OS Name:	PortToExcel.cls
	Instancing:	5-Multisuse


	------------------------------------------
b)	Add the following code in the Class Module
	------------------------------------------	

Option Explicit
Private flxObject As MSFlexGrid
Private strFilename As String
Private lngRow As Long
Private lngCol As Long
Private cmpString1 As String
Private cmpString2 As String
Private lngMaxColumn As Long
Private lngMaxRow As Long
Private xlApp As Excel.Application
Private xlBook As Excel.Workbook
Private xlSheet As Excel.Worksheet
Private NoOfRows As Long

Public Sub PortToExcel()
DoEvents
On Error GoTo errDialog
    frmXlPort.Visible = False
    frmXlPort.cmdlgXlPortObject.CancelError = True
    frmXlPort.cmdlgXlPortObject.Filter = "(Excel Files)|*.xls"
    frmXlPort.cmdlgXlPortObject.Flags = cdlOFNCreatePrompt Or cdlOFNHideReadOnly Or cdlOFNNoReadOnlyReturn
    frmXlPort.cmdlgXlPortObject.DialogTitle = "Save this report as ..."
    frmXlPort.cmdlgXlPortObject.InitDir = App.Path
    frmXlPort.cmdlgXlPortObject.ShowSave
    strFilename = frmXlPort.cmdlgXlPortObject.FileName
    If Trim(strFilename) = "" Then
       Exit Sub
    End If
On Error GoTo errHandler
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)
    frmXlPort.Visible = True
    frmXlPort.ZOrder 0
    frmXlPort.Refresh
    lngMaxColumn = flxObject.Cols
    lngMaxRow = flxObject.Rows
    frmXlPort.prgXLPort.Min = 0
    frmXlPort.prgXLPort.Max = lngMaxRow
    frmXlPort.prgXLPort.Value = 0
'Flow to Insert Cells From FlexGrid Object
'To Excel
    frmXlPort.lblXLPortStatus.Caption = "Porting Data to Excel, Please wait..."
    frmXlPort.lblXLPortStatus.Refresh
    If lngMaxRow < 1 Then GoTo errHandler
        For lngRow = 0 To lngMaxRow - 1
            DoEvents
            If boolStop = True Then GoTo errHandler
            frmXlPort.prgXLPort.Value = lngRow
            frmXlPort.prgXLPort.Refresh
            For lngCol = 0 To lngMaxColumn - 1
            DoEvents
                If boolStop = True Then GoTo errHandler
                flxObject.Col = lngCol
                flxObject.Row = lngRow
                If flxObject.Row > flxObject.FixedRows - 1 Then
                    If flxObject.CellBackColor > 0 Then
                        xlSheet.Range(xlSheet.Cells(lngRow + 1, lngCol + 1).Address, xlSheet.Cells(lngRow + 1, lngCol + 1).Address).Interior.Color = flxObject.CellBackColor
                    Else
                        If Not flxObject.ForeColor = vbWhite Then
                            xlSheet.Range(xlSheet.Cells(lngRow + 1, lngCol + 1).Address, xlSheet.Cells(lngRow + 1, lngCol + 1).Address).Interior.Color = vbWhite
                        Else
                            xlSheet.Range(xlSheet.Cells(lngRow + 1, lngCol + 1).Address, xlSheet.Cells(lngRow + 1, lngCol + 1).Address).Interior.Color = vbBlack
                        End If
                    End If
                    xlSheet.Cells(lngRow + 1, lngCol + 1).Borders.Color = vbBlack
                    xlSheet.Cells(lngRow + 1, lngCol + 1).Font.Name = flxObject.CellFontName
                    xlSheet.Cells(lngRow + 1, lngCol + 1).Font.Size = flxObject.CellFontSize
                    xlSheet.Cells(lngRow + 1, lngCol + 1).Font.Color = flxObject.ForeColor
                Else
                    If flxObject.GridColor > 0 Then
                        xlSheet.Range(xlSheet.Cells(lngRow + 1, lngCol + 1).Address, xlSheet.Cells(lngRow + 1, lngCol + 1).Address).Interior.Color = flxObject.GridColor
                    Else
                        If Not flxObject.ForeColor = vbWhite Then
                            xlSheet.Range(xlSheet.Cells(lngRow + 1, lngCol + 1).Address, xlSheet.Cells(lngRow + 1, lngCol + 1).Address).Interior.Color = vbWhite
                        Else
                            xlSheet.Range(xlSheet.Cells(lngRow + 1, lngCol + 1).Address, xlSheet.Cells(lngRow + 1, lngCol + 1).Address).Interior.Color = vbBlack
                        End If
                    End If
                    xlSheet.Cells(lngRow + 1, lngCol + 1).Borders.Color = vbBlack
                    xlSheet.Cells(lngRow + 1, lngCol + 1).Font.Name = flxObject.CellFontName
                    xlSheet.Cells(lngRow + 1, lngCol + 1).Font.Size = flxObject.CellFontSize
                    xlSheet.Cells(lngRow + 1, lngCol + 1).Font.Color = flxObject.ForeColor
                End If
                    xlSheet.Cells(lngRow + 1, lngCol + 1).Value = flxObject.TextMatrix(lngRow, lngCol)
            Next lngCol
        Next lngRow
            'Disabling the Alerts from Excel
        xlSheet.Application.DisplayAlerts = False
        frmXlPort.prgXLPort.Min = 0
        frmXlPort.prgXLPort.Max = NoOfRows
        frmXlPort.prgXLPort.Value = 0
        frmXlPort.lblXLPortStatus.Caption = "Applying format to the Rows ..."
        frmXlPort.lblXLPortStatus.Refresh
            'Flow to Merge Rows and Columns
        For lngRow = 0 To NoOfRows - 1
        DoEvents
            If boolStop = True Then GoTo errHandler
            frmXlPort.prgXLPort.Value = lngRow
            frmXlPort.prgXLPort.Refresh
            For lngCol = 0 To lngMaxColumn - 2
            DoEvents
                If boolStop = True Then GoTo errHandler
                cmpString1 = Trim(flxObject.TextMatrix(lngRow, lngCol))
                cmpString2 = Trim(flxObject.TextMatrix(lngRow, lngCol + 1))
                If cmpString1 = cmpString2 Then
                   xlSheet.Range(xlSheet.Cells(lngRow + 1, lngCol + 1).Address, xlSheet.Cells(lngRow + 1, lngCol + 2).Address).Merge
                End If
            Next
        Next
             
        frmXlPort.prgXLPort.Min = 0
        frmXlPort.prgXLPort.Max = lngMaxColumn
        frmXlPort.prgXLPort.Value = 0
        frmXlPort.lblXLPortStatus.Caption = "Applying format to the Columns ..."
        frmXlPort.lblXLPortStatus.Refresh
           
        For lngCol = 0 To lngMaxColumn - 1
        DoEvents
            If boolStop = True Then GoTo errHandler
            frmXlPort.prgXLPort.Value = lngCol
            frmXlPort.prgXLPort.Refresh
            For lngRow = 0 To NoOfRows - 2
            DoEvents
                If boolStop = True Then GoTo errHandler
                cmpString1 = Trim(flxObject.TextMatrix(lngRow, lngCol))
                cmpString2 = Trim(flxObject.TextMatrix(lngRow + 1, lngCol))
                If cmpString1 <> "" And cmpString2 <> "" Then
                   If cmpString1 = cmpString2 Then
                       xlSheet.Range(xlSheet.Cells(lngRow + 1, lngCol + 1).Address, xlSheet.Cells(lngRow + 2, lngCol + 1).Address).Merge
                   End If
                End If
            Next
        Next
             'Calling Excel to Adjust Column Width to Size of the Cells
        frmXlPort.prgXLPort.Min = 1
        frmXlPort.prgXLPort.Max = 100
        frmXlPort.prgXLPort.Value = 1
        frmXlPort.prgXLPort.Refresh
        frmXlPort.lblXLPortStatus.Caption = "Formatting: Adjusting Width and Heights of Cells  ..."
        frmXlPort.lblXLPortStatus.Refresh
        xlSheet.Range(xlSheet.Cells(1, 1).Address, xlSheet.Cells(lngMaxRow, lngMaxColumn).Address).Columns.AutoFit
        frmXlPort.prgXLPort.Value = 50
        frmXlPort.prgXLPort.Refresh
        xlSheet.Range(xlSheet.Cells(1, 1).Address, xlSheet.Cells(lngMaxRow, lngMaxColumn).Address).Rows.AutoFit
        frmXlPort.prgXLPort.Value = 100
        frmXlPort.prgXLPort.Refresh


       frmXlPort.prgXLPort.Min = 0
       frmXlPort.prgXLPort.Max = lngMaxRow
       frmXlPort.prgXLPort.Value = 0
       frmXlPort.prgXLPort.Refresh
       frmXlPort.lblXLPortStatus.Caption = "Aligning cells according to grid values ..."
       frmXlPort.lblXLPortStatus.Refresh
       For lngRow = 0 To lngMaxRow - 1
       DoEvents
           If boolStop = True Then GoTo errHandler
           frmXlPort.prgXLPort.Value = lngRow
           frmXlPort.prgXLPort.Refresh
           For lngCol = 0 To lngMaxColumn - 1
           DoEvents
               If boolStop = True Then GoTo errHandler
               flxObject.Col = lngCol
               flxObject.Row = lngRow
               If flxObject.Row > flxObject.FixedRows - 1 Then
                  If IsNumeric(flxObject.TextMatrix(lngRow, lngCol)) Then
                     xlSheet.Range(xlSheet.Cells(lngRow + 1, lngCol + 1).Address, _
                     xlSheet.Cells(lngRow + 1, lngCol + 1).Address).HorizontalAlignment = 4 'Right
                  ElseIf IsDate(flxObject.TextMatrix(lngRow, lngCol)) Then
                     xlSheet.Range(xlSheet.Cells(lngRow + 1, lngCol + 1).Address, _
                     xlSheet.Cells(lngRow + 1, lngCol + 1).Address).HorizontalAlignment = 4 'Right
                  Else
                     xlSheet.Range(xlSheet.Cells(lngRow + 1, lngCol + 1).Address, _
                     xlSheet.Cells(lngRow + 1, lngCol + 1).Address).HorizontalAlignment = 2 'Left
                  End If
               Else
                    xlSheet.Range(xlSheet.Cells(lngRow + 1, lngCol + 1).Address, xlSheet.Cells(lngRow + 1, lngCol + 1).Address).HorizontalAlignment = 7 'Center Across Selection
               End If
         Next lngCol
     Next lngRow
    frmXlPort.prgXLPort.Visible = False
    frmXlPort.prgXLPort.Refresh
    frmXlPort.lblXLPortStatus.AutoSize = True
    frmXlPort.lblXLPortStatus.Refresh
    If Right(Trim(strFilename), 4) <> ".xls" Then
        strFilename = strFilename & ".xls"
    End If
    frmXlPort.lblXLPortStatus.Caption = "Saving File as & " & strFilename
    frmXlPort.lblXLPortStatus.Refresh
    'Saving file as xl file
    xlSheet.SaveAs strFilename
        
    frmXlPort.lblXLPortStatus.Caption = "Done!"
    frmXlPort.lblXLPortStatus.Refresh
    frmXlPort.Hide
    MsgBox "Conversion succesfully completed", vbInformation + vbOKOnly, "Port to Excel - Finished"
    Set xlSheet = Nothing
    xlBook.Close True
    Set xlBook = Nothing
    xlApp.Quit
    Set xlApp = Nothing
    Unload frmXlPort
    Exit Sub
errHandler:
    MsgBox "Conversion succesfully not completed", vbCritical + vbOKOnly, "Error"
    Set xlSheet = Nothing
    xlBook.Close False
    Set xlBook = Nothing
    xlApp.Quit
    Set xlApp = Nothing
    Unload frmXlPort
    Exit Sub
errDialog:
    MsgBox "Conversion succesfully not completed", vbCritical + vbOKOnly, "Error"
    Unload frmXlPort
    Exit Sub
End Sub

Public Property Let RowsTillMergingShouldTakePlace(ByVal lngRows As Long)
'This property allows you to setup
    NoOfRows = lngRows
End Property

Public Property Let FlxGridName(ByVal vNewValue As Object)
    Set flxObject = vNewValue
End Property

Private Sub Class_Terminate()
    If Not frmXlPort Is Nothing Then
        Set frmXlPort = Nothing
    End If
    Set flxObject = Nothing
End Sub


Step - 4:
	Add a module and give the following properties
	Name:		modPortToXL
	OS Name:	modPortToXL.bas
	

a)	Public boolStop As Boolean


Step - 5:
	
	Compile the activex Dll to create a Dll PortToExcel.dll
	
How to use:

	Open your project and refer to the dll - PortToXL, under references dialog.

	Suppose you have created a button with a following name called - "cmdPrtToXl"
	in your application to port your MSFlexigrid formatted reports to Excel then
	Write the following code to do that:

	Private Sub cmdPrtToXl_Click()		
	DIM PrtXL AS NEW PortToXL
		PrtXL.RowsTillMergingShouldTakePlace
		PrtXL.FlxGridName
		PrtXL.PortToExcel 
	End Sub
**********************************E**N**D***********************************************************
Thats all folks, Again i want to make you all very clear, that u may use this software 
for demonstration purposes only,and use it their application in your production environment 
after complete testing of this software ONLY.

Thanks and Encourage for more things like this.