FTP | CCD | Buscar | Trucos | Trabajo | Foros |
|
Registrarse | FAQ | Miembros | Calendario | Guía de estilo | Temas de Hoy |
|
Herramientas | Buscar en Tema | Desplegado |
|
#1
|
|||
|
|||
Hola Noe, hace unos minutos vi un procedimiento similar, creado por Andre_Marcel en el 2005. El sitio es http://www.q3.nu/trucomania/ en el foro más reciente. te envío una copia, y como dije lo acabo de ver y aún no lo he probado.
procedimiento que efectua la exp. procedure TMDMain.ExportaExcel(oQuery:TQuery; bCabecera, bAbrirArchivo, bSoloFldVisible:Boolean); var archivo_a_escribir_Aux ,nom_archivo, exte_archivo : string; archivo_a_escribir :textfile; i,sw_tit: integer; begin sw_tit := 0; oQuery.ExecSQL; if oQuery.RecordCount > 0 then begin SaveDlg.Filter := 'Archivos Excel (*.csv)|*.csv'; SaveDlg.InitialDir:= 'C:\'; SaveDlg.FileName:= ''; if SaveDlg.Execute then begin archivo_a_escribir_Aux:= SaveDlg.filename; assignfile(archivo_a_escribir, archivo_a_escribir_Aux); {$I-} rewrite(archivo_a_escribir); {$I+} if ioresult = 32 then ShowMessage('Error: Archivo abierto por otra aplicación...') else begin oQuery.DisableControls; oQuery.First; While not oQuery.Eof do begin // Generar Titulo de Campos if bCabecera then begin if sw_tit = 0 then begin sw_tit := 1; for i := 0 to oQuery.FieldCount - 1 do begin if bSoloFldVisible then begin if oQuery.Fields[i].Visible then begin write(archivo_a_escribir, oQuery.Fields[i].DisplayLabel); write(archivo_a_escribir, ';'); flush(archivo_a_escribir); end; end else begin write(archivo_a_escribir, oQuery.Fields[i].DisplayLabel); write(archivo_a_escribir, ';'); flush(archivo_a_escribir); end; end; writeln(archivo_a_escribir,' '); end; end; //Datos for i := 0 to oQuery.FieldCount - 1 do begin if bSoloFldVisible then begin if oQuery.Fields[i].Visible then begin write(archivo_a_escribir, oQuery.Fields[i].AsString); write(archivo_a_escribir, ';'); flush(archivo_a_escribir); end; end else begin write(archivo_a_escribir, oQuery.Fields[i].AsString); write(archivo_a_escribir, ';'); flush(archivo_a_escribir); end; end; writeln(archivo_a_escribir,' '); oQuery.Next; end; oQuery.EnableControls; CloseFile(archivo_a_escribir); if bAbrirArchivo then Ver_Archivo(SaveDlg.FileName, ExtractFilePath(SaveDlg.FileName)) // Procedimiento 2 else MessageBox(hManejador, 'Archivo Generado', VG_NOMBRE_APLICACION, MB_OK + MB_ICONINFORMATION); end; end; end else MessageBox(hManejador, 'No hay Registros', VG_NOMBRE_APLICACION, MB_OK + MB_ICONINFORMATION); end; procedimiento para abrir archivo de excel desde delphi procedure TMDMain.Ver_Archivo(cNom_Archivo, cRuta_Archivo:String); var ErrorCod: Integer; begin if (Trim(cNom_Archivo) <> '') and (Trim(cRuta_Archivo) <> '') then if Trim(ExtractFileExt(cRuta_Archivo+'\'+cNom_Archivo)) <> '' then ErrorCod:= ShellExecute(0, 'Open', PChar(cNom_Archivo), Nil, PChar(cRuta_Archivo), SW_SHOWNORMAL) else exit; Case ErrorCod of ERROR_FILE_NOT_FOUND : begin MessageBox(hManejador, 'Archivo no Encontrado', VG_NOMBRE_APLICACION, MB_OK + MB_ICONINFORMATION); end; ERROR_PATH_NOT_FOUND : begin MessageBox(hManejador, 'Ruta de Archivo no Encontrado', VG_NOMBRE_APLICACION , MB_OK + MB_ICONINFORMATION); end; SE_ERR_NOASSOC : begin MessageBox(hManejador, 'No se ha encontrado un programa para abrir este tipo de archivo', VG_NOMBRE_APLICACION, MB_OK + MB_ICONINFORMATION); end; else if ErrorCod < 32 then // Códigos de error de ejecución no exitosa MessageBox(hManejador, 'Error al abrir archivo', VG_NOMBRE_APLICACION, MB_OK + MB_ICONERROR); end //Case ErrorCod of end; ejemplo de llamada para exportación: // Exportar desde Grilla--> oQuery;bCabecera, bAbrirArchivo, bSoloFldVisible MDMain.ExportaExcel(TQuery(Grilla_DatosX.DataSource.DataSet), True, True, False); // Exportar desde Query--> oQuery;bCabecera, bAbrirArchivo, bSoloFldVisible MDMain.ExportaExcel(QueryXX, True, True, False); |
|
|
|