04/04/2008, 11:10
|
| | Fecha de Ingreso: diciembre-2007 Ubicación: En Lima - Perú
Mensajes: 70
Antigüedad: 16 años, 11 meses Puntos: 0 | |
Re: exportar csv a excel Cita:
Iniciado por Analyzer
Código:
Private Sub Command1_Click()
Dim CVS As String
Dim XLS As String
With CommonDialog1
'Para Abrir el CSV
.Filter = "Archivo CSV|*.csv|Todos los archivos|*.*"
.DialogTitle = " Seleccionar el archivo CSV"
.ShowOpen
CVS = .FileName
'Para guardar el XLS
.Filter = "Archivo Xls|*.xls"
.FileName = ""
.DialogTitle = " Escriba l nombre del archivo Xls "
.ShowSave
XLS = .FileName
End With
If CVS = "" Or XLS = "" Then
Exit Sub
Else
Call Exportar_CSV_XLS(CVS, XLS)
End If
End Sub
Private Sub Exportar_CSV_XLS(path_Cvs As String, path_Xls As String)
On Error GoTo ErrSub
Dim obj_Excel As Object
Dim Fila As Integer, Columna As Integer
Dim Contenido As String, Lineas As Variant
Dim datos As Variant, MC As Integer
'Lee el contenido del CSV y lo almacena en la variable
Open path_Cvs For Input As #1
Contenido = Input$(LOF(1), #1)
Close
'Nuevo objeto Excel
Set obj_Excel = CreateObject("Excel.Application")
With obj_Excel
'Agrega un libro
.Workbooks.Add
' Obtiene el número de líneas del Csv con la función split
Lineas = Split(Contenido, vbCrLf)
For Fila = 0 To UBound(Lineas)
'Separa los datos de la linea
datos = Split(Lineas(Fila), ",")
'Recorre los datos de esta fila que corresponden a cada campo
For Columna = 0 To UBound(datos)
' Agrega el dato a la celda de la hoja activa
.ActiveSheet.Cells(Fila + 1, Columna + 1) = datos(Columna)
Next
If MC < Columna Then
MC = Columna
End If
Next
'Selecciona toda la hoja
.ActiveSheet.UsedRange.Select
'Autoajusta las columnas
.Selection.Columns.AutoFit
'Selecciona el encabezado
.ActiveSheet.Range(.ActiveSheet.Cells(1, 1), .ActiveSheet.Cells(1, MC)).Select
End With
' Aplica atributos a la fuente a la selección anterior ( los encabezados )
With obj_Excel.Selection.Font
.Name = "Verdana"
.FontStyle = "Bold"
.Size = 14
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Underline = xlUnderlineStyleNone
End With
' Guarda el documento Xls
obj_Excel.ActiveWorkbook.SaveAs _
FileName:=path_Xls, _
FileFormat:=xlNormal, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False
obj_Excel.ActiveWorkbook.Close False
'Cierra el archivo y elimina la variable
obj_Excel.Quit
Set obj_Excel = Nothing
'Fin
MsgBox "Archivo Xls guardado ", vbInformation
Exit Sub
'Error
ErrSub:
MsgBox Err.Description
On Error Resume Next
If Not obj_Excel Is Nothing Then
obj_Excel.Quit
Set obj_Excel = Nothing
End If
End Sub
Y este codigo donde lo pongo ???? |