
06/04/2010, 13:06
|
| | Fecha de Ingreso: noviembre-2006
Mensajes: 227
Antigüedad: 18 años, 5 meses Puntos: 6 | |
Respuesta: Problema Exportando a Excel Haber si te sirve este codigo para exportar el contenido de una grilla a Excel
En un Modulo coloca este codigo tal cual
Código:
Public Sub ExportarGrid(Grid As MSHFlexGrid, 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 'Exporta a 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 "Los datos fueron exportados Correctamente", vbOKOnly, "Finalizado"
Exit Sub
ErrHandler:
'Gimme the default mouse pointer dude!
Screen.MousePointer = vbDefault
MsgBox "¡Vaya!, ¡Vaya!, ¡Vaya! lo lamento hoy ¡No puedo exportar Tu fichero!", vbOKOnly, "Error"
Exit Sub
End Sub
Y lo llamas desde un Command Button asi:
Código:
Private Sub CmdExportar_Click()
On Error GoTo ErrHandler
CD.Filter = "Excel File(*.xls)|*.xls|Text File (*.txt)|*.txt"
CD.FilterIndex = 1
CD.ShowSave
ExportarGrid NombredeTuGrilla, CD.FileName, CD.FilterIndex
ErrHandler:
End Sub
sobra decir que tienes que agregar el componente Commondialog que en mi caso lo he llamado CD
Espero te sirva |