Exportar MSFlexGrid a Excel

[ValentinoMolinari]

crea un Módulo ExportarExcel y dentro coloca esto

Public Sub ExportarGrid(Grid As MSFlexGrid, FileName As String, FileType)

Dim i As Long
Dim j As Long

On Error GoTo ErrHandler

'Let's put a HourGlass pointer for the mouse
Screen.MousePointer = vbHourglass

If FileType = 1 Then 'Export to excel

'Gimme the workbook
Dim wkbNew As Excel.Workbook
'Gimme the worksheet for the workbook
Dim wkbSheet As Excel.Worksheet
'Gimme the range for the worksheet
Dim Rng As Excel.Range

'Does the file exist?
If Dir(FileName) <> "" Then
'Kill it boy!
Kill FileName
End If

On Error GoTo CreateNew_Err

'Let's create the workbook kid!
Set wkbNew = Workbooks.Add
wkbNew.SaveAs FileName

'Add a WorkPage
Set wkbSheet = wkbNew.Worksheets(1)

'Set the values in the range
Set Rng = wkbSheet.Range("A1:" + Chr(Grid.Cols + 64) + CStr(Grid.Rows))
For j = 0 To Grid.Cols - 1
For i = 0 To Grid.Rows - 1
If Val(j) <> 3 Then
Rng.Range(Chr(j + 1 + 64) + CStr(i + 1)) = Grid.TextMatrix(i, j)
Else
Rng.Range(Chr(j + 1 + 64) + CStr(i + 1)) = Val(Replace(Grid.TextMatrix(i, j), ",", "."))
End If
Next
Next

'Close and save the file
wkbNew.Close True

GoTo NoErrors

CreateNew_Err:
'Stop the show!
wkbNew.Close False
Set wkbNew = Nothing
Resume ErrHandler

Else 'Export to text

Dim Fs As Variant
Dim a As Variant

'I know, the File # sounds smarter, but, I like weird things :) !
On Error GoTo ErrHandler
Set Fs = CreateObject("Scripting.FileSystemObject")
Set a = Fs.CreateTextFile(FileName, True)
Dim Line As String
For j = 0 To Grid.Rows - 1
For i = 0 To Grid.Cols - 1
Line = Line + Grid.TextMatrix(i, j) + vbTab
Next
a.WriteLine (Line)
Line = ""
Next
a.Close

End If

NoErrors:
'Gimme the default mouse pointer dude!
Screen.MousePointer = vbDefault
MsgBox "Nuevo Libro Creado Correctamente", vbOKOnly, "Finished"
Exit Sub

ErrHandler:
'Gimme the default mouse pointer dude!
Screen.MousePointer = vbDefault
MsgBox "¡Vaya! ¡No puedo exportar el fichero!", vbOKOnly, "Error"
Exit Sub
End Sub


luego en el formulario coloca un Boton y dentro el siguiente código
On Error GoTo ErrHandler
CD.Filter = "Excel File(*.xls)|*.xls|Text File (*.txt)|*.txt"
CD.FilterIndex = 1
CD.ShowSave
ExportarGrid gridTest, CD.FileName, CD.FilterIndex
ErrHandler:

no olvides agregar un CommonDialod y llamalo CD
espero te sirva saludos