by Kannan C S (1 Submission)
Category: OLE/COM/DCOM/Active-X
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Wed 4th April 2001
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Port MSFlexiGrid Data To A Excel File
API Declarations
NOTE: STRICTLY FOR DEMONSTRATION PURPOSE ONLY
VBcoders
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.
