excel.pas

delphi开发的委托加工管理系统源代码

unit excel;
interface
uses
  Windows,Messages, SysUtils, Classes, Graphics, Controls, Forms,Dialogs,
  DB, ComObj;
type
  TKHTMLFormatCellEvent = procedure(Sender: TObject; CellRow,CellColumn: Integer; FieldName: string;
    var CustomAttrs, CellData: string) of object;
  TDataSetToExcel = class(TComponent)
  private
    FDataSet: TDataSet;
    FOnFormatCell: TKHTMLFormatCellEvent;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Transfer(const FileName: string; Title: string = ');
  published
    property DataSet: TDataSet read FDataSet write FDataSet;
  end;
implementation
constructor TDataSetToExcel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDataSet := nil;
end;
destructor TDataSetToExcel.Destroy;
begin
  inherited;
end;
procedure TDataSetToExcel.Transfer(const FileName:string;Title:string = ');
var
  ExcelApp, MyWorkBook: Variant;
  i: byte;
  j, a: integer;
  s, k, b, CustomAttrs: string;
begin
  try
    ExcelApp := CreateOleObject('Excel.Application');
    MyWorkBook := CreateOleObject('Excel.Sheet');
  except
    on Exception do raise exception.Create('无法打开Excel文件，请确认已经安装Execl')
  end;
  MyWorkBook := ExcelApp.WorkBooks.Add;
  MyWorkBook.WorkSheets[1].Range['A1:D1'].Merge(True);
  MyWorkBook.WorkSheets[1].Range['A1:D2'].HorizontalAlignment := $FFFFEFF4;
  MyWorkBook.WorkSheets[1].Cells[1, 1].Value := Title;
  with FDataSet do
  begin
    i := 2;
    for j := 0 to FieldCount - 1 do
    begin
      if Fields[j].Visible then
      begin
        b := Fields[j].DisplayLabel;
        CustomAttrs := ';
        if Assigned(FOnFormatCell) then
          FOnFormatCell(Self, 1, i,
            Fields[j].FieldName, CustomAttrs, b);
        MyWorkBook.WorkSheets[1].Cells[i, j + 1].Value := b;
      end;
    end;
    i := 3;
    Close;
    Open;
    First;
    a := 2;
    while not Eof do
    begin
      for j := 0 to FieldCount - 1 do
      begin
        if Fields[j].Visible then
        begin
          CustomAttrs := ';
          k := Fields[j].Text;
          if Assigned(FOnFormatCell) then
            FOnFormatCell(Self, i, a,
              Fields[j].FieldName, CustomAttrs, k);
          MyWorkBook.WorkSheets[1].Cells[i, j + 1].Value := k;
          inc(a);
        end;
      end;
      Inc(i);
      Next;
    end;
  end;
  s := 'A3:D' + IntToStr(i - 1);
  s := 'A1:D' + IntToStr(i - 1);
  MyWorkBook.WorkSheets[1].Columns[1].ColumnWidth := 20;
  MyWorkBook.WorkSheets[1].Columns[4].ColumnWidth := 25;
  MyWorkBook.WorkSheets[1].Rows[1].RowHeight := 50;
  MyWorkBook.WorkSheets[1].Rows[1].VerticalAlignMent := $FFFFEFF4;
  MyWorkBook.WorkSheets[1].Range[s].Font.Name := '仿宋';
  s := 'A2:D' + IntToStr(i - 1);
  MyWorkBook.WorkSheets[1].Range[s].Borders.LineStyle := 1;
  MyWorkBook.WorkSheets[1].PageSetup.CenterHorizontally := True;
  MyWorkBook.WorkSheets[1].PageSetup.PrintTitleRows := 'A1';
  try
    MyWorkBook.Saveas(FileName);
    MyWorkBook.Close;
  except
    MyWorkBook.Close;
  end;
  ExcelApp.Quit;
  ExcelApp := UnAssigned;
end;
end.