Ver Mensaje Individual
  #2  
Antiguo 02-09-2008
vinicc vinicc is offline
Miembro
 
Registrado: ago 2006
Posts: 31
Reputación: 0
vinicc Va por buen camino
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);







Responder Con Cita