Ver Mensaje Individual
  #6  
Antiguo 27-06-2012
Avatar de roman
roman roman is offline
Moderador
 
Registrado: may 2003
Ubicación: Ciudad de México
Posts: 20.269
Reputación: 10
roman Es un diamante en brutoroman Es un diamante en brutoroman Es un diamante en bruto
Bueno, supongo que ese formulario era para mostrar alguna animación mientras se realizaba la exportación. Pero eso no es parte esencial del proceso. Por ejemplo, si omitimos lo relacionado a dicho formulario y dos o tres cosas no esenciales quedaría algo así:

Código Delphi [-]
unit Unit2;

interface

uses DB, Forms;

procedure ExportarExcel( DataSet:TDataSet ; cNomArchivo: string);

implementation

uses ComObj;

procedure ExportarExcel( DataSet:TDataSet ; cNomArchivo: string);
var
  Excel: variant;      // Aplicación Excel
  Libro: variant;      // Libro de trabajo
  Hoja: variant;       // Hoja de cálculo
  fila, columna, campo: integer;
  marca: string;
begin
  //Application. CreateForm( TfrmAnimacion, frmAnimacion) ;
  //With frmAnimacion do
  try
        //Show;
        //Screen.Cursor := crHourGlass;
        // Creamos el objeto de automatizació n OLE
        try
          Excel := CreateOleObject( 'Excel.Applicati on');
          try
            Excel.visible := False;

            // Creamos un nuevo libro de trabajo
            Excel.SheetsInNewWorkbook := 1;
            Libro := Excel.WorkBooks. Add;

            // Obtenemos una referencia a la página del libro
            Hoja := Libro.WorkSheets[ 1];

            with DataSet do begin
              // Recorremos los campos para poner sus nombres como
              // encabezado en la primera fila
              fila := 1;
              columna := 1;
              for campo := 0 to FieldCount - 1 do
                with Fields[campo] do
                  begin
                     //if Visible then begin // Sólo se incluyen los campos visibles
                       Hoja.Cells[fila, columna] := DisplayName;
                       Inc(columna) ;
                     //end;
                  end;
              Hoja.Rows[fila] .Font.Bold := True;

              //Screen.Cursor := crHourglass;   // cambio a reloj arena
              DisableControls;

              try
                Marca:= Dataset.Bookmark;  // guardo donde estaba el dataset
                First;
                // Recorremos los registros del dataset
                while not Eof do begin
                  Inc(fila);     // Cada registro va en una nueva fila
                  columna := 1;
                  // Recorremos los campos para ir llenando las celdas de la fila
                  for campo := 0 to FieldCount - 1 do
                    with Fields[campo] do begin
                      //if Visible then begin // Sólo se incluyen los campos visibles
                        if not IsNull then  // Si el valor es nulo, no lo asignamos
                          if DataType = ftString then
                            Hoja.Cells[fila, columna] := '''' + AsString
                          else
                            try
                              Hoja.Cells[fila, columna] := Value;
                            except
                              Hoja.Cells[fila, columna] := DisplayText;
                            end;
                        Inc(columna) ;
                      //end;
                    end;
                  Next; // Avanzamos al siguiente registro
                end;

              finally
                Dataset.Bookmark := Marca;  // dejo el dataset donde estaba
                EnableControls;
              end;
            end;

          finally
            try Hoja.Cells.Columns. AutoFit; except end;  // Autoajuste
            //Excel.Visible :== True; // Mostramos el Excel
            // Grabamos el archivo
            Libro.saveas( cNomArchivo) ;
            Excel.quit ;
            //Screen.Cursor := crDefault;
          end;

        except
           //Application. MessageBox( 'Excel no se encuentra instalado en este equipo, no se puede exportar','Error' ,mb_OK + mb_IconExclamation) ;
        end;
  finally
        //Free;
  end;

end;

end.

Eso debe compilar sin problemas.

// Saludos
Responder Con Cita