Usuario
pasar de dbase a excel desde Visual Basic

Pregunta
-
tengo un programa viejo desarrollado visual basic que tenia una función para exportar a una hoja excel, lo que me ocurre es que el usuario ha cambiado de maquina (Windows 7 con office 2007) y esa versión de excel me da error, me dice "Microsoft Office Excel dejó de funcionar" y no me genera el fichero.
No se si el problema es del dbase o del excel pero todo a ocurrido al cambiar el excel.
Me dicen que en un windows 7 a 64 no puedo instalar una version anterior de office, asi que tengo que cambiar el codigo del programa, por muchas cosas que pruebo no encuentro solucion
adjunto codigo:
Db.Execute "SELECT * INTO [dBase III;DATABASE=" & BASEDATOS & "].[REVISTA] FROM " & sNombreTabla ' Creamos el fichero DBF Db.Execute (cad) sOrigen = BASEDATOS & "\" & "revista.dbf" sDestino = BASEDATOS & "\" & "revista.xls" ' Si existe el fichero lo borramos If ExisteFichero(sDestino, "") = True Then Kill sDestino End If '***************************************** ' Copiamos el fichero dbf como un excel Dim xl As Object Set xl = CreateObject("EXCEL.APPLICATION") xl.workbooks.Open filename:=sOrigen xl.ActiveSheet.Name = sTabla xl.ActiveWorkbook.SaveAs filename:=sDestino, FileFormat:=1 xl.workbooks.Close Set xl = Nothing DoEvents
Aran
Todas las respuestas
-
Hay mas de una solución. Yo desarrollé una que hasta ahora funciona en todas las versiones de Window y Officce que he probado.
Basta pasar un recordset(ADO) para que se cree una hoja de Microsoft Excel, de una manera muy sencilla, con muy pocas líneas. Descarga la mdb del siguiente enlace.
http://www.tucondominioaldia.com.ve/archivos/expXLSRec.rar
Cordialmente, Carlos
-
-
-
-
Aqui el código. La mdb esta en formato 2003
Option Compare Database
Dim fs, f, ts
Dim linea As String, ctl As CommandButton
Private Sub creaxls_Click()
'ojo: no hay tratamiento de errores
'el objetivo es crear un archivo xls, de la manera mas fácil que hay
'creando un archivo xls en blanco al cual se llena con una página web.
'como no todos sabemos el lenguaje HTML, he desarrollado una rutina que utilizè
' una vez para paginar una tabla, pasando un recordset como argumento al procedimiento creaTabla
Set ctl = Me!creaxls
Dim rst As New ADODB.Recordset, conn As New ADODB.Connection
Set conn = CurrentProject.Connection
rst.Open "SELECT codigo, nombre, fax, direccion, [codigo postal], telefono from clientes", conn, 2, 4
If Not rst.EOF Then
creaTabla rst ' aqui pasas el recordset...puedes probar quitando algunas columnas
End If
'/*cierro objetos recordset
rst.Close
Set rst = Nothing
conn.Close
Set conn = Nothing
End Sub
Public Sub creaTabla(rst As ADODB.Recordset)
'este módulo fué desarrollado por mi
'por favor utilízalo pero mantén el crédito
'mi: puedes ser tu o cualquier otro :) una broma
'*** no lo comento por completo, para que se fajen a revisarlo*** jeje
Set fs = CreateObject("Scripting.FileSystemObject")
strdir = CurrentProject.Path & "\"
'If Dir(strdir, vbDirectory) = "" Then
' MkDir strdir ' si no la encuentra, la crea pues!
'End If
If Dir(strdir & "miprimerxls.xls") <> "" Then
Kill strdir & "miprimerxls.xls" 'si el archivo existe, lo elimina
End If
Set f = fs.createtextFile(strdir & "miprimerxls.xls") ' crea el archivo en blanco
Set f = fs.GetFile(strdir & "miprimerxls.xls") ' lo selecciona
Set ts = f.openastextstream(8, -2) 'lo abre en modo de escritura
ts.Write "<html><head><Title>Mi primera página de excel desde Microsoft Access</title>" & vbCrLf
ts.Write "<body>" & vbCrLf 'abro la seccion cuerpo de la página
ts.Write "<h2>Listado de clientes</h2>" & vbCrLf 'un subtítulo
ts.Write "<table width=""100%"" border=""1px"">" & vbCrLf 'abro la tabla
columnas = rst.Fields.Count
ancho = 100 / columnas & "%"
For Each fld In rst.Fields
linea = linea & "<th width=""" & ancho & """>" & fld.Name & "</th>"
Next fld
linea = linea & vbCrLf
ts.Write linea
Do Until rst.EOF
linea = Empty
linea = "<tr>"
For i = 0 To columnas - 1
linea = linea & "<td>" & rst(i) & "</td>"
Next i
linea = linea & "</tr>" & vbCrLf
ts.Write linea
rst.MoveNext
Loop
ts.Write "</table></body></html>"
ts.Close 'cierro la página para que esté lista
Set fs = Nothing
ctl.HyperlinkAddress = strdir & "miprimerxls.xls" 'abre la página
ctl.Hyperlink.Follow
End Subdonde Set ctl = Me!creaxls es un boton/ currentproject.path no existe en visual basic y asi, algunos cambios menores
-
muchas gracias por tu ayuda
he creado un proyecto nuevo con visual basic 6 he pegado tu codigo para ver si funciona y me da errores
1.- option compare database
2. (rst As ADODB.Recordset) ... no se ha definido el tipo.
....
claro que lo que tu me envias esta en access y no en visual igual tengo que añadir algo al proyecto??
Aran -
Para Visual Basic: crea referencia a librería de DAO. Cambia nombre de base de datos en la conexión. Te queda resolver el que abra el archivo de Microsoft Excel.
Dim fs, f, ts
Dim linea As String, ctl As CommandButton
Private Sub creaxls_Click()
'ojo: no hay tratamiento de errores
'el objetivo es crear un archivo xls, de la manera mas fácil que hay
'creando un archivo xls en blanco al cual se llena con una página web.
'como no todos sabemos el lenguaje HTML, he desarrollado una rutina que utilizè
' una vez para paginar una tabla, pasando un recordset como argumento al procedimiento creaTabla
Set ctl = Me!creaxls
Dim rst As DAO.Recordset, conn As DAO.Database
Set conn = OpenDatabase("C:\Documents and Settings\carlos\Mis documentos\midb97.mdb ")
Set rst = conn.OpenRecordset("SELECT codigo, nombre, fax, direccion, [codigo postal], telefono from clientes")
If Not rst.EOF Then
creaTabla rst ' aqui pasas el recordset...puedes probar quitando algunas columnas
End If
'/*cierro objetos recordset
rst.Close
Set rst = Nothing
conn.Close
Set conn = Nothing
End Sub
Public Sub creaTabla(rst As DAO.Recordset)
'este módulo fué desarrollado por mi
'por favor utilízalo pero mantén el crédito
'mi: puedes ser tu o cualquier otro :) una broma
'*** no lo comento por completo, para que se fajen a revisarlo*** jeje
Set fs = CreateObject("Scripting.FileSystemObject")
strdir = App.Path & "\"
'If Dir(strdir, vbDirectory) = "" Then
' MkDir strdir ' si no la encuentra, la crea pues!
'End If
If Dir(strdir & "miprimerxls.xls") <> "" Then
Kill strdir & "miprimerxls.xls" 'si el archivo existe, lo elimina
End If
Set f = fs.createtextFile(strdir & "miprimerxls.xls") ' crea el archivo en blanco
Set f = fs.GetFile(strdir & "miprimerxls.xls") ' lo selecciona
Set ts = f.openastextstream(8, -2) 'lo abre en modo de escritura
ts.Write "<html><head><Title>Mi primera página de excel desde Microsoft Access</title>" & vbCrLf
ts.Write "<body>" & vbCrLf 'abro la seccion cuerpo de la página
ts.Write "<h2>Listado de clientes</h2>" & vbCrLf 'un subtítulo
ts.Write "<table width=""100%"" border=""1px"">" & vbCrLf 'abro la tabla
columnas = rst.Fields.Count
ancho = 100 / columnas & "%"
For Each fld In rst.Fields
linea = linea & "<th width=""" & ancho & """>" & fld.Name & "</th>"
Next fld
linea = linea & vbCrLf
ts.Write linea
Do Until rst.EOF
linea = Empty
linea = "<tr>"
For i = 0 To columnas - 1
linea = linea & "<td>" & rst(i) & "</td>"
Next i
linea = linea & "</tr>" & vbCrLf
ts.Write linea
rst.MoveNext
Loop
ts.Write "</table></body></html>"
ts.Close 'cierro la página para que esté lista
Set fs = Nothing
End Sub -
-
No estoy de acuerdo en lo absoluto. Puedes dar cualquier formato, y sí es un archivo de Microsoft Excel, el cual es creado en tiempo de ejecución y no hay importación.
Con el siguiente segmento de código, puedes darle el formato que quieras.
ts.Write "<style> .verdana10{font-family: verdana; font-size:10; color: #333333;}" & vbCrLf
ts.Write ".verdana10R{font-family: verdana; font-size:10; color: RGB(255,0,0);}" & vbCrLf
ts.Write ".verdana10U{font-family: verdana; font-size:10; color: RGB(0,0,0); text-decoration: underline}" & vbCrLf
ts.Write ".verdana10C{font-family: verdana; font-size:10; color: RGB(0,0,0); background-color: RGB(0,255,0)}" & vbCrLf
ts.Write "</style>" & vbCrLf
...y luego
...
Do While Not rst.EOF
linea = "<tr><td class=verdana10>".... asignas las clases, según la necesidad. Si hay un método mas fácil y que permita crear fórmulas, sin tener mas conocimientos que HTML básico, por favor, me interesa mucho.
-
Tiene sus limitaciones,podes poner una formula =a1+a2 y te la va a tomar pero si queres formatear numeros,formatos condicionales o avanzados,o que te aparezcan las lineas hasta el 65536 con el separador de celdas gris tenes que escribir las 65536 * 256 td para que parezca un excel normal.
-
-
-
Hola Aran. Si encierras entre comillas simples, se convierte en texto.
linea = linea & "<td>' " & rst(i) & "' </td>" esta en negrita y subrayado para que lo veas. También puedes:
linea = linea & "<td>" & cstr(rst(i)) & "</td>" ' función que convierte a texto
Prueba a avisa si tienes problema
-
primero gracias por la rapidez
la primera opcion me escribe en la celda '01' no me sirve porque el fichero lo tiene que leer otro programa que no interpreta esto como dato valido, solo 01
la segunda opcion me escribe '1'
¿se te ocurre alguna otra idea?
Aran -
-
yo lo genero como tu dices y se ve '01
el programa que tiene que importar los datos de la Hoja de calculo me da error al encontrar ese dato con comilla, hasta ahora pasaba 01 sin comillas ni nada
si se te ocurre alguna forma de escrbirlo asi en excel desde el codigo que me pasaste..
muchas gracias
Aran -
-
-
-
Aran, cambia este segmento de código
For i = 0 To columnas - 1
'Debug.Print rst.Fields(i).Name & "/" & rst.Fields(i).Type
If rst.Fields(i).Type = 4 Or rst.Fields(i).Type = 5 Or rst.Fields(i).Type = 131 Then '4=numerico-simple/ 5=numerico-doble/ 131=decimal
valor = Format(rst(i), "##,##0.00")
ElseIf rst.Fields(i).Type = 202 Then
valor = "=texto(""" & Nz(rst(i), 0) & """;""0#"")"
Else
valor = rst(i)
End If
linea = linea & "<td>" & valor & "</td>"
Next iAran, si puedes indicarme los nombres de los campos, se podría dar ese formato solo a los que desees
-
Aran, podemos dar un formato a ciertas columnas: [codigo postal], por ejemplo. Define cuántos caracteres máximo tendrá esa columna: por ejemplo 10
For i = 0 To columnas - 1
'Debug.Print rst.Fields(i).Name & "/" & rst.Fields(i).Type
If rst.Fields(i).Type = 4 Or rst.Fields(i).Type = 5 Or rst.Fields(i).Type = 131 Then '4=numerico-simple/ 5=numerico-doble/ 131=decimal
valor = Format(rst(i), "0#,##0.00")
ElseIf rst.Fields(i).Type = 202 Then
If Not IsNull(rst(i)) Then
valor = rst(i)
Else
valor = " "
End If
If rst.Fields(i).Name = "codigo Postal" Then
valor = "=texto(""" & valor & """;""0########"")" ' aqui le estamos asignando un ancho fijo al campo [codigo postal]; las demás columnas no tendrán este formato.Creo que si podemos dar cualquier formato
Else
valor = rst(i)
End If
Else
valor = rst(i)
End If
linea = linea & "<td>" & valor & "</td>"
Next i
-
-
hola de nuevo, ya he probado y al poner
valor = "=texto(""" & valor & """;""0#"")"
lo que hace es escribirme en la celda texto(01;"0#")
LO CURIOSO ES QUE ENTRO EN LA HOJA DE CALCULO Y SI HAGO F2 SOBRE LA CELDA CON LA FORMULA =TEXTO(01;"0#) ME LA PONE CORRECTAMENTO COMO "01".
EMPIEZO A PENSAR QUE VA A SER IMPOSIBLE HACERLO CON ESTE SISTEMA, PORQUE NO PUEDO ACCEDER A LA HOJA DE CALCULO SIN EL OBJETO EXCEL CREADO NO?
alguna idea más???
Aran -
Bueno, yo tengo Office 2003 y funcionó.
Explícame lo que haces cuando le das click a la celda; al salir se 'acomoda'? Revisa la fórmula con F2 a ver si el separador es la coma en vez del punto y coma. Debe ser un detalle de este tipo.
Como te comenté líneas atrás, lo ideal sería darle formato a algunas columnas que lo requieran.
-
Efectivamante depende de la version del excel si lo abro con 2007 interpreta bien la formula, si lo abro con 97 me sale mal, el problema lo tengo porque este fichero es para enviar a otro programa de un tercero que no tiene porque abrir el excel sino que lo importa con su programa y me dice que al leer el fichero excel le da error. Como solucion decirle que lo abra antes de importarlo no me parece bien
Aran -
-
-