leodanis
15 de Julio del 2004

Hola,
quisiera que me ayudaran. quiero agregar datos a un documento excel desde delphi y no se como hacerlo. Espero que me ayuden

Gracias

Aar?artinez
15 de Julio del 2004

unit GEXCEL;
interface

USES SysUtils,ComObj,Dialogs,dbtables;

TYPE
FileFormat = (xlAddIn, xlCSV, xlCSVMac, xlCSVMSDOS, xlCSVWindows, xlDBF2,
xlDBF3, xlDBF4, xlDIF, xlExcel2, xlExcel3, xlExcel4,
xlExcel4Workbook, xlIntlAddIn, xlIntlMacro, xlNormal,
xlSYLK, xlTemplate, xlText, xlTextMac, xlTextMSDOS,
xlTextWindows, xlTextPrinter, xlWK1, xlWK3, xlWKS,
xlWQ1, xlWK3FM3, xlWK1FMT, xlWK1ALL);


PROCEDURE SALVAEXCEL(mORIGEN,mDESTINO:STRING);
FUNCTION CAJAEXPORTARXLS(VAR ARCHIVO:STRING;mCAMINO:STRING):BOOLEAN;

implementation

USES avanCE;

FUNCTION CAJAEXPORTARXLS(VAR ARCHIVO:STRING;mCAMINO:STRING):BOOLEAN;
VAR SALVA:BOOLEAN;
DLGSALVA:TSaveDialog;
begin
DLGSALVA:=TSaveDialog.CREATE(NIL);
SALVA:=FALSE;
DLGSALVA.FileEditStyle :=fsComboBox;
DLGSALVA.Filter := 'MS EXCEL (*.XLS)|*.XLS';
DLGSALVA.Title:='Tabla se Exportará como';
DLGSALVA.Options := [ofOverwritePrompt,ofHideReadOnly, ofPathMustExist];
DLGSALVA.InitialDir:=mCAMINO;
DLGSALVA.DefaultExt :='XLS';
DLGSALVA.FileName:=ARCHIVO;
if DLGSALVA.Execute then
BEGIN
SALVA:=TRUE;
ARCHIVO:=DLGSALVA.FileName;
END;
DLGSALVA.FREE;
RESULT:=SALVA;
end;

PROCEDURE METEDATOS(ORIGEN:STRING;VAR EXCEL:VARIANT);
VAR TABLA:TTABLE;
SHEET,RANGO:VARIANT;
R,C:LONGINT;
CAMPO:STRING;
AVAN,NREG:LONGINT;
FRMAVANCE:TFRMAVANCE;
BEGIN
SHEET:=EXCEL.WORKBOOKS[1].WORKSHEETS['DATOS'];
TABLA:=TTABLE.CREATE(NIL);
TABLA.TABLENAME:=ExtractFileName(ORIGEN);
TABLA.DATABASENAME:=ExtractFileDir(ORIGEN);
TABLA.ACTIVE:=TRUE;
NREG:=TABLA.RECORDCOUNT;
AVAN:=1;
FRMAVANCE := TFRMAVANCE.Create(NIL);
FRMAVANCE.CAPTION :='SALVANDO ARCHIVO EN FORMATO XLS..';
FRMAVANCE.Show;
FRMAVANCE.MIAVANCE.PROGRESS:=AVAN;
TABLA.FIRST;
RANGO:=SHEET.RANGE['B7:AO7'];
RANGO.COLUMNS.INTERIOR.COLORINDEX:=48; {COLOR GRIS}
RANGO.INTERIOR.PATTERN:=$000000001; {CONTANTE RELLENO SOLIDO}
RANGO.Borders.LineStyle:=$00000001;
SHEET.DisplayGridlines:=False;
FOR C:=0 TO TABLA.FIELDCOUNT-1 DO
Begin
If (C=0) THEN SHEET.CELLS[7,C+2]:='Antigüedad / Edad';
If (1<=C) AND (C<=36) THEN SHEET.CELLS[7,C+2]:=IntToStr(C-1);
If (C=37) THEN SHEET.CELLS[7,C+2]:='<35';
If (C=38) THEN SHEET.CELLS[7,C+2]:='<Error';
If (C=39) THEN SHEET.CELLS[7,C+2]:='<Suma';
End;
R:=8;
WHILE NOT TABLA.EOF DO
BEGIN
FOR C:=0 TO TABLA.FIELDCOUNT-1 DO
BEGIN
CAMPO:=TABLA.FIELDS[C].FIELDNAME;
SHEET.CELLS[R,C+2]:=TABLA.FIELDBYNAME(CAMPO).ASSTRING;
END;
R:=R+1;
TABLA.NEXT;
INC(AVAN);
FRMAVANCE.MIAVANCE.PROGRESS:=TRUNC(AVAN/NREG*100);
FRMAVANCE.Update;
END;
TABLA.Close;
TABLA.FREE;
FRMAVANCE.HIDE;
FRMAVANCE.FREE;
END;



PROCEDURE SALVAEXCEL(mORIGEN,mDESTINO:STRING);
CONST XLWBATWORKSHEET=-4167;
VAR
EXCEL:VARIANT;
BEGIN
If not VarIsEmpty(Excel) then
Begin
Excel.DisplayAlerts := False;
Excel.Quit;
End;
Excel := CreateOleObject('Excel.Application');
Excel.Visible := false;
Excel.WorkBooks.Add(XLWBATWORKSHEET);
Excel.WorkBooks[1].WorkSheets[1].Name:='DATOS';
IF FileExists(mDESTINO) THEN DELETEFILE(mDESTINO);
TRY
METEDATOS(mORIGEN,EXCEL);
Excel.ActiveSheet.SaveAs(mDESTINO,xlCSV);
Except
MESSAGEDLG('Ocurrio un Error mientras trataba de salvar:'+chr(10)+mDESTINO,MTERROR,[MBOK],0);
Excel.DisplayAlerts := False;
Excel.Quit;
end;
Excel.DisplayAlerts := False;
Excel.Quit;
END;

end.