| |||
Respuesta: Exportar MSFlexGrid a Excel 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 |