[sintecsl]

Esta unidad forma parte de un programa mucho mas extenso. Es por ello que algunos objetos no los tendras, pero lo puedes adaptar a lo que quieras y te dá las claves para realizar dicha exportación.

Código Delphi [-]

unit ExportaXLS;

interface

Uses Grids;

// Added by MANEL 31/10/2010 7:22:54
//Procedimiento que exporta la Tabla a XLS
procedure ExportarXLS(const Tabla : TStringGrid; const Fichero : String);

implementation

uses ComObj, Graphics, CARATULAS, { ShellApi,} Dlg_MensajeTransaccion,
     Configuracion, SysUtils, StrUtils, UtilidadSTR, UtilidadFiles;

procedure ExportarXLS(const Tabla : TStringGrid; const Fichero : String);
label Comienza;
const //Constantes cogidas del fichero ExcelXP.pas
  xlCenter = $FFFFEFF4;
  xlJustify = $FFFFEFDE;
  xlBottom = $FFFFEFF5;
  xlLeft = $FFFFEFDD;
  xlRight = $FFFFEFC8;
  xlTop = $FFFFEFC0;
var
  Excel, WorkBook, WorkSheet, Range : Variant;
  RangoIni, RangoFin : string;
  F, C : Integer; //Fila y columna de la Hoja XLS
  Row : Integer; //Fila de la Tabla
  ConPrecios : Boolean; //Determina si se imprimen los precios
procedure FuenteParaLaHoja(const NomFuente : string; TamFuente : Integer);
begin
     //Le daremos formato a toda la tabla
     RangoIni:='A1';
     RangoFin:='E'+IntToStr(Tabla.RowCount+6);
     Range:=WorkSheet.Range[RangoIni,RangoFin];
     Range.Font.Name:=NomFuente;
     Range.Font.Size:=TamFuente;
end;
procedure PonCabecera;
var
  c : Integer;
begin
     //Lo hacemos por rango
     RangoIni:='A'+IntToStr(F);
     RangoFin:='E'+IntToStr(F);
     Range:=WorkSheet.Range[RangoIni,RangoFin];
     Range.Font.Size:=12; //Tamaño fuente
     Range.Font.Bold:=True; //En negrita
     Range.Font.Underline:=True; //Subrayado
     Range.Interior.Color:=clSilver; //Fondo
     Range.VerticalAlignment:=xlTop;
     Range.HorizontalAlignment:=xlCenter;
     //Ponemos valores
     for C:=1 to Tabla.ColCount do
       WorkSheet.Cells[F, C]:=Tabla.Cells[C-1,0];
end;
{procedure FormatoCant;
begin
     WorkSheet.Cells[F, C]:=Tabla.Cells[C-1,Row];
     WorkSheet.Cells[F, C].NumberFormat:='###.###';
     WorkSheet.Cells[F, C].Font.Name:='Arial'; //Tipo fuente
     WorkSheet.Cells[F, C].Font.Size:=10; //Tamaño fuente
     WorkSheet.Cells[F, C].VerticalAlignment:=xlTop;
     WorkSheet.Cells[F, C].HorizontalAlignment:=xlCenter;
end;
procedure FormatoUD;
var
  Celda : string;                           
begin
     Celda:=Tabla.Cells[C-2,Row];
     if (Pos('*',Celda)>0)Or(Pos('@',Celda)>0) then Exit; //Clave de formato
     WorkSheet.Cells[F, C]:=Tabla.Cells[C-1,Row];
     WorkSheet.Cells[F, C].Font.Name:='Arial'; //Tipo fuente
     WorkSheet.Cells[F, C].Font.Size:=10; //Tamaño fuente
     WorkSheet.Cells[F, C].VerticalAlignment:=xlTop;
     WorkSheet.Cells[F, C].HorizontalAlignment:=xlCenter;
end; }
procedure FormatoConcepto;
var
  Celda : string;
begin
     //Esta parte es común para todos
     WorkSheet.Cells[F, C]:=Tabla.Cells[C-1,Row];
     Celda:=Tabla.Cells[C-2,Row];
     if (Pos('*',Celda)>0)Or(Pos('@',Celda)>0) then
       Begin //Formato especial
            WorkSheet.Cells[F, C].Font.Bold:=True; //En negrita
            if Pos('@',Celda)>0 then //Nota
               WorkSheet.Cells[F, C].Font.Color:=clGreen//clRed //Color fuente
            else WorkSheet.Cells[F, C].Font.Color:=clBlue; //Color fuente
            if Pos('**',Celda)>0 then //Subtotales, totales parciales y totales
               begin
                    WorkSheet.Cells[F, C].VerticalAlignment := xlBottom;
                    WorkSheet.Cells[F, C].HorizontalAlignment:=xlRight;
               end
       end;
end;
procedure FormatoTotal;
var
  Celda : string;
begin
     //Miramos que se imprime
     Celda:=Tabla.Cells[C-4,Row];
     if Pos('*',Celda)>0 then //Significa que hay algún tipo de total o resumen
        WorkSheet.Cells[F, C].Font.Bold:=True; //En negrita
     if (Config.Impresora.Total)and(Pos('***',Celda)>0) then  //Totales
        WorkSheet.Cells[F, C]:=Tabla.Cells[C-1,Row]
     Else
     if (Config.Impresora.SubTotales)and(Celda='**') then //SubTotales
        WorkSheet.Cells[F, C]:=Tabla.Cells[C-1,Row]
     else
     if (Celda='*')and(Config.Impresora.Total) then //Son del resumen
        WorkSheet.Cells[F, C]:=Tabla.Cells[C-1,Row]
     else
     if Config.Impresora.Totales then //Parciales
        WorkSheet.Cells[F, C]:=Tabla.Cells[C-1,Row];
end;
var
  Dir, FileTemp : string;
begin
      // Added by MANEL 30/10/2010 7:45:11
      //Importante podriamos poner la mayoría de las celdas de totales con fórmulas
      //con la siguiente instrucción Range.formula:='+A1*C1' o celda a celda con
      //WorkSheet.Cells[F, 4].formula:='+A1*C1'; por ejemplo

      ConPrecios:=ConfirmaPregunta('¿ PONER PRECIOS A LA HOJA DE CÁLCULO?' )=0;
    try
      // crear instancia de la aplicación Excel (requieres la unidad ComObj)

      Excel := CreateOleObject('Excel.Application');

      // evitar que nos pregunte si deseamos sobreescribir el archivo

   //   Excel.DisplayAlerts := false;  ****LA ELIMINAMOS PARA QUE LOS ERRORES SEAN VISIBLES

      // agregar libro de trabajo (El número es una constante)

      Workbook := Excel.Workbooks.Add(-4167);

      // tomar una referencia a la hoja creada y darle nombre

      WorkSheet := WorkBook.WorkSheets[1]; //1ª hoja
      WorkSheet.Name := 'PRESUPUESTO'; //Nombre de la hoja creada

      FuenteParaLaHoja('Arial',10); //Damos formato a toda la hoja

      //Llenamos las Celdas
      //(Toma en cuenta que las columnas y filas empiezan en 1, y que en el
      // WorkSheet.Cells[F,C]. F es la Fila y C es la Columna.)
      F:=2; //Apuntamos a la primera fila
      //Damos formato de ancho a las columnas
      WorkSheet.Cells[F, 1].ColumnWidth:=9;  //Cant
      WorkSheet.Cells[F, 2].ColumnWidth:=7;  //Ud
      WorkSheet.Cells[F, 3].ColumnWidth:=90; //Descripción
      WorkSheet.Cells[F, 4].ColumnWidth:=14; //Pu
      WorkSheet.Cells[F, 5].ColumnWidth:=16; //Totales

      //Rellenamos datos del presupuesto
      C:=3; //Columna donde introduciremos
      WorkSheet.Cells[F, C]:='PRESUPUESTO Nº : '+Caratula.LabeledEdit1.Text;
      //Damos formato
      WorkSheet.Cells[F, C].Font.Size:=14; //Tamaño fuente
      WorkSheet.Cells[F, C].Font.Bold:=True; //En negrita
      WorkSheet.Cells[F, C].Font.Color:=clRed; //Color fuente
      WorkSheet.Cells[F, C].Font.Underline:=True; //Subrayado
      Inc(F,2);
      WorkSheet.Cells[F, C]:='Ref. : '+Caratula.LabeledEdit2.Text;
      //Damos formato
      WorkSheet.Cells[F, C].Font.Size:=12; //Tamaño fuente
      WorkSheet.Cells[F, C].Font.Color:=clBlue; //Color fuente
      WorkSheet.Cells[F, C].VerticalAlignment:=xlTop; //Justificacion Vertical
      WorkSheet.Cells[F, C].HorizontalAlignment:=xlJustify; //Justificación Horizontal

      // Tomando desde el StringGrid "Tabla" pasado por valor a este objeto
      //Creamos cabecera *************************************
      Inc(F,2);
      C:=1;
      PonCabecera;
      //Fin cabecera ******************************************

      //Daremos formato por rango de las columnas. Es obvio que en los totales.
      //apartados, anotaciones etc, tendrán un formato concreto distinto
      Inc(F);
      //Congelamos el panel visual de cabecera
      WorkSheet.Cells[F,1].Select; //Posicionamos cursor en la primera
    //  WorkSheet.Rows[F].Select; //Selecciona toda una fila
      Excel.ActiveWindow.FreezePanes := True;
    //  WorkSheet.Cells.Select; //Selección de toda la hoja
      //Columna Cant
      RangoIni:='A'+IntToStr(F);
      RangoFin:='A'+IntToStr(F+Tabla.RowCount);
      Range:=WorkSheet.Range[RangoIni,RangoFin];
      Range.VerticalAlignment:=xlTop;
      Range.HorizontalAlignment:=xlCenter;
      Range.NumberFormat:='###.###,##';

      //Columna Ud
      RangoIni:='B'+IntToStr(F);
      RangoFin:='B'+IntToStr(F+Tabla.RowCount);
      Range:=WorkSheet.Range[RangoIni,RangoFin];
      Range.VerticalAlignment:=xlTop;
      Range.HorizontalAlignment:=xlCenter;

      //Columna Concepto
      RangoIni:='C'+IntToStr(F);
      RangoFin:='C'+IntToStr(F+Tabla.RowCount);
      Range:=WorkSheet.Range[RangoIni,RangoFin];
      Range.VerticalAlignment:=xlTop;
      Range.HorizontalAlignment:=xlLeft;
      Range.WrapText:=True; //Indica adaptación de línea al contenido

      //Columna Pu y Total
      RangoIni:='D'+IntToStr(F);
      RangoFin:='E'+IntToStr(F+Tabla.RowCount);
      Range:=WorkSheet.Range[RangoIni,RangoFin];
      Range.VerticalAlignment:=xlBottom;
      Range.HorizontalAlignment:=xlRight;
      Range.WrapText:=True; //Indica adaptación de línea al contenido
      Range.NumberFormat:='###.###,## €';

      //Con los anteriores formatos esta definido lo que es por defecto.
      //Ahora hay que determinar las filas que son especiales

      //Colocamos datos de la tabla
      DlgTransaccion.Barra.ValorMax:=Tabla.RowCount;
      DlgTransaccion.Show;
      for Row:=1 To Tabla.RowCount-1 do
        begin
             DlgTransaccion.Barra.Progress:=Row;
             C:=1; //Columna "Cant"
             WorkSheet.Cells[F, C]:=AnsiReplaceStr(Tabla.Cells[C-1,Row],'.','');
             C:=2; //Columna "Ud"
             WorkSheet.Cells[F, C]:= Tabla.Cells[C-1,Row];
             C:=3; //Columna "Concepto"
             FormatoConcepto; //En esta hay distintas alineaciones y formatos
             // A partir de aquí mirar si los precios son "visibles"
             if ConPrecios then //Ponemos las columnas de precios
               begin
                    C:=4; //Columna "PU"
                    if Config.Impresora.Pu then
                       WorkSheet.Cells[F, C]:=Tabla.Cells[C-1,Row];
                    C:=5; //Columna "Total"
                    FormatoTotal;
               end;
             Inc(F);
        end;
      // guardamos en archivo XLS la hoja generada
      DlgTransaccion.Close; //Cerramos dialogo transacción
      try //Esta parte es la mas delicada
        //Crearemos un temporal que eliminaremos
        Dir:=ExtractFilePath(Fichero);
        FileTemp:=DameFicheroTemp(Dir,'EXPORTACION PRESUPUESTO','.XLS');
        WorkBook.SaveAs(FileTemp);
        Excel.Quit;
        if not CopiaFichero(FileTemp,Fichero) then
           MensageError('No se pudo copiar el fichero :'#13+Fichero);
        BorraFichero(FileTemp); //Borramos el temporal
      except //Capturamos fallos principales de guardado o de apertura simultanea
            //Desconectamos
            Excel.Quit;
            DlgTransaccion.Close;
            Exit;
      end;
    finally // Si se produce algún error desconectar el objeto
         DlgTransaccion.Close;
         Excel.Quit;
    end
end;

end.

Espero que sea de ayuda.

Adjunto fichero.